summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-04-22 15:46:39 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-04-22 15:46:39 (GMT)
commiteea5a1d7018e33f7fa50a613d6a5b912e7bb6707 (patch)
tree07c4be3b6538e21a3c5f5538a7ef1831f6d9ed9c
parent918dbfe6102b60da44efe1c8344461ad3bddb4b0 (diff)
downloadtcl-eea5a1d7018e33f7fa50a613d6a5b912e7bb6707.zip
tcl-eea5a1d7018e33f7fa50a613d6a5b912e7bb6707.tar.gz
tcl-eea5a1d7018e33f7fa50a613d6a5b912e7bb6707.tar.bz2
The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring
it into agreement with its docs. Further investigation reveals it was the docs that were incorrect. * doc/BoolObj.3: Corrections to the documentation of Tcl_GetBooleanFromObj to bring it into agreement with what this public interface has always done, including noting the difference in function between Tcl_GetBooleanFromObj and Tcl_GetBoolean. * generic/tclGet.c: Revised Tcl_GetBoolean to no longer be a wrapper around Tcl_GetBooleanFromObj (different function!). * generic/tclObj.c: Removed TclGetTruthValueFromObj routine that was added yesterday. Revisions so that only Tcl_GetBoolean-approved values get the "boolean" Tcl_ObjType. This retains the fix for [Bug 1187123]. * generic/tclInt.h: Revert most recent change. * generic/tclBasic.c: * generic/tclCompCmds.c: * generic/tclDictObj.c: * generic/tclExecute.c: * tests/obj.test:
-rw-r--r--ChangeLog26
-rw-r--r--doc/BoolObj.346
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclDictObj.c4
-rw-r--r--generic/tclExecute.c10
-rw-r--r--generic/tclGet.c7
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclObj.c62
-rw-r--r--tests/obj.test34
10 files changed, 103 insertions, 102 deletions
diff --git a/ChangeLog b/ChangeLog
index 1fa90a0..fd0448c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+2005-04-22 Don Porter <dgp@users.sourceforge.net>
+
+ The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring
+ it into agreement with its docs. Further investigation reveals it
+ was the docs that were incorrect.
+
+ * doc/BoolObj.3: Corrections to the documentation of
+ Tcl_GetBooleanFromObj to bring it into agreement with what this
+ public interface has always done, including noting the difference
+ in function between Tcl_GetBooleanFromObj and Tcl_GetBoolean.
+
+ * generic/tclGet.c: Revised Tcl_GetBoolean to no longer be a
+ wrapper around Tcl_GetBooleanFromObj (different function!).
+
+ * generic/tclObj.c: Removed TclGetTruthValueFromObj routine
+ that was added yesterday. Revisions so that only
+ Tcl_GetBoolean-approved values get the "boolean" Tcl_ObjType.
+ This retains the fix for [Bug 1187123].
+
+ * generic/tclInt.h: Revert most recent change.
+ * generic/tclBasic.c:
+ * generic/tclCompCmds.c:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * tests/obj.test:
+
2005-04-21 Don Porter <dgp@users.sourceforge.net>
* doc/GetInt.3: Convert argument "string" to "str" to agree with code.
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index 41c0a73..f586621 100644
--- a/doc/BoolObj.3
+++ b/doc/BoolObj.3
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: BoolObj.3,v 1.5 2004/10/07 15:37:43 dkf Exp $
+'\" RCS: @(#) $Id: BoolObj.3,v 1.6 2005/04/22 15:46:51 dgp Exp $
'\"
.so man.macros
.TH Tcl_BooleanObj 3 8.0 Tcl "Tcl Library Procedures"
@@ -65,25 +65,35 @@ and, if the object is not already a boolean object,
frees any old internal representation.
.PP
\fBTcl_GetBooleanFromObj\fR attempts to return a boolean value
-from the Tcl object \fIobjPtr\fR.
-If the object is not already a boolean object,
-it will attempt to convert it to one.
-If an error occurs during conversion, it returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
-unless \fIinterp\fR is NULL.
-Otherwise, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR
-and stores the boolean value in the address given by \fIboolPtr\fR.
-If the object is not already a boolean object,
-the conversion will free any old internal representation.
-Objects having a string representation equal to any of \fB0\fR,
-\fBfalse\fR, \fBno\fR, or \fBoff\fR have a boolean value 0; if the
-string representation is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or
-\fBon\fR the boolean value is 1.
-Any of these string values may be abbreviated, and upper-case spellings
-are also acceptable.
+corresponding to the value of the Tcl object \fIobjPtr\fR.
+If \fIobjPtr\fR is of the boolean type, its boolean value
+is written at the address given by \fIboolPtr\fR.
+If \fIobjPtr\fR has a string representation recognized by
+\fBTcl_GetBoolean\fR, then \fIobjPtr\fR is converted to boolean
+type and its boolean value is written at the address given
+by \fIboolPtr\fR. If \fIobjPtr\fR holds any value recognized as
+a number by Tcl, then if that value is zero a 0 is written at
+the address given by \fIboolPtr\fR and if that
+value is non-zero a 1 is written at the address given by \fIboolPtr\fR.
+In all cases where a value is written at the address given
+by \fIboolPtr\fR, \fBTCL_OK\fR is returned.
+If the value of \fIobjPtr\fR does not meet any of the conditions
+above, then \fBTCL_ERROR\fR is returned and error message is
+left in the interpreter's result unless \fIinterp\fR is NULL.
+.PP
+Note that the routines \fBTcl_GetBooleanFromObj\fR and
+\fBTcl_GetBoolean\fR are not functional equivalents.
+The set of values for which \fBTcl_GetBooleanFromObj\fR
+will return \fBTCL_OK\fR is strictly larger than
+the set of values for which \fBTcl_GetBoolean\fR will do the same.
+For example, the value "5" passed to \fBTcl_GetBooleanFromObj\fR
+will lead to a \fBTCL_OK\fR return (and the boolean value 1),
+while the same value passed to \fBTcl_GetBoolean\fR will lead to
+a \fBTCL_ERROR\fR return.
.SH "SEE ALSO"
-Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult,
+Tcl_GetBoolean
.SH KEYWORDS
boolean, boolean object, boolean type, internal representation, object, object type, string representation
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 43a0a2a..8df8d17 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.146 2005/04/21 21:24:03 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.147 2005/04/22 15:46:52 dgp Exp $
*/
#include "tclInt.h"
@@ -4042,7 +4042,7 @@ Tcl_ExprBoolean(interp, string, ptr)
/*
* Store a boolean based on the expression result.
*/
- result = TclGetTruthValueFromObj(interp, resultPtr, ptr);
+ result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
if (result != TCL_OK) {
@@ -4152,7 +4152,7 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result == TCL_OK) {
- result = TclGetTruthValueFromObj(interp, resultPtr, ptr);
+ result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
return result;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index def3851..b04c845 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.63 2005/04/21 21:24:07 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.64 2005/04/22 15:46:53 dgp Exp $
*/
#include "tclInt.h"
@@ -1113,7 +1113,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
testTokenPtr[1].size);
Tcl_IncrRefCount(boolObj);
- code = TclGetTruthValueFromObj(NULL, boolObj, &boolVal);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
Tcl_DecrRefCount(boolObj);
if (code == TCL_OK) {
/*
@@ -3247,7 +3247,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
Tcl_IncrRefCount(boolObj);
- code = TclGetTruthValueFromObj(NULL, boolObj, &boolVal);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
Tcl_DecrRefCount(boolObj);
if (code == TCL_OK) {
if (boolVal) {
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 043e1d3..2f1b1cd 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.28 2005/04/21 21:29:18 dgp Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.29 2005/04/22 15:46:54 dgp Exp $
*/
#include "tclInt.h"
@@ -2645,7 +2645,7 @@ DictFilterCmd(interp, objc, objv)
boolObj = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(boolObj);
Tcl_ResetResult(interp);
- if (TclGetTruthValueFromObj(interp, boolObj,
+ if (Tcl_GetBooleanFromObj(interp, boolObj,
&satisfied) != TCL_OK) {
TclDecrRefCount(boolObj);
result = TCL_ERROR;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 961566c..8e4a04d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.183 2005/04/21 20:24:11 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.184 2005/04/22 15:46:54 dgp Exp $
*/
#include "tclInt.h"
@@ -2539,7 +2539,7 @@ TclExecuteByteCode(interp, codePtr)
*/
int b1;
- result = TclGetTruthValueFromObj(interp, valuePtr, &b1);
+ result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
if (result != TCL_OK) {
if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) {
jmpOffset[1] = jmpOffset[0];
@@ -2616,7 +2616,7 @@ TclExecuteByteCode(interp, codePtr)
i1 = (w != W0);
}
} else {
- result = TclGetTruthValueFromObj((Tcl_Interp *) NULL,
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
valuePtr, &i1);
i1 = (i1 != 0);
}
@@ -2647,7 +2647,7 @@ TclExecuteByteCode(interp, codePtr)
i2 = (w != W0);
}
} else {
- result = TclGetTruthValueFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
}
if (result != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
@@ -4302,7 +4302,7 @@ TclExecuteByteCode(interp, codePtr)
valuePtr, &d);
}
if (result == TCL_ERROR && *pc == INST_LNOT) {
- result = TclGetTruthValueFromObj((Tcl_Interp *)NULL,
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL,
valuePtr, &boolvar);
i = (long)boolvar; /* i is long, not int! */
}
diff --git a/generic/tclGet.c b/generic/tclGet.c
index bad8289..bfc3501 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclGet.c,v 1.12 2005/04/21 20:24:13 dgp Exp $
+ * RCS: @(#) $Id: tclGet.c,v 1.13 2005/04/22 15:46:57 dgp Exp $
*/
#include "tclInt.h"
@@ -183,9 +183,12 @@ Tcl_GetBoolean(interp, str, boolPtr)
obj.length = strlen(str);
obj.typePtr = NULL;
- code = Tcl_GetBooleanFromObj(interp, &obj, boolPtr);
+ code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
+ if (code == TCL_OK) {
+ *boolPtr = obj.internalRep.longValue;
+ }
return code;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 68c2827..727b879 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.224 2005/04/21 20:24:13 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.225 2005/04/22 15:46:57 dgp Exp $
*/
#ifndef _TCLINT
@@ -1892,8 +1892,6 @@ MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_((
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ ((
ProcessGlobalValue *pgvPtr));
-MODULE_SCOPE int TclGetTruthValueFromObj _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr));
MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
char *pattern, Tcl_Obj *unquotedPrefix,
int globFlags, Tcl_GlobTypeData* types));
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 42acb01..bc073c2 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.80 2005/04/21 20:35:04 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.81 2005/04/22 15:46:59 dgp Exp $
*/
#include "tclInt.h"
@@ -1233,50 +1233,6 @@ Tcl_SetBooleanObj(objPtr, boolValue)
*
* Tcl_GetBooleanFromObj --
*
- * Attempt to return a boolean from the Tcl object "objPtr". If the
- * object is not already of the "boolean" Tcl_ObjType, an attempt
- * will be made to convert it to one.
- *
- * Note that only exact boolean values are recognized, not all
- * numeric values (use TclGetTruthValueFromObj() for that).
- *
- * Results:
- * The return value is a standard Tcl object result. If an error occurs
- * during conversion, an error message is left in the interpreter's
- * result unless "interp" is NULL.
- *
- * Side effects:
- * If the object is not already a boolean, the conversion will free
- * any old internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get boolean. */
- register int *boolPtr; /* Place to store resulting boolean. */
-{
- register int result;
-
- if (objPtr->typePtr == &tclBooleanType) {
- result = TCL_OK;
- } else {
- result = SetBooleanFromAny(interp, objPtr);
- }
-
- if (result == TCL_OK) {
- *boolPtr = (int) objPtr->internalRep.longValue;
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetTruthValueFromObj --
- *
* Attempt to return a boolean from the Tcl object "objPtr". This
* includes conversion from any of Tcl's numeric types.
*
@@ -1292,7 +1248,7 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
*/
int
-TclGetTruthValueFromObj(interp, objPtr, boolPtr)
+Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object from which to get boolean. */
register int *boolPtr; /* Place to store resulting boolean. */
@@ -1300,12 +1256,19 @@ TclGetTruthValueFromObj(interp, objPtr, boolPtr)
double d;
long l;
+ if (objPtr->typePtr == &tclBooleanType) {
+ *boolPtr = (int) objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
/*
* The following call retrieves a numeric value without shimmering
* away any existing numeric intrep Tcl_ObjTypes.
*/
if (Tcl_GetDoubleFromObj(NULL, objPtr, &d) == TCL_OK) {
*boolPtr = (d != 0.0);
+
+ /* Attempt shimmer to "boolean" objType */
+ SetBooleanFromAny(NULL, objPtr);
return TCL_OK;
}
/*
@@ -1331,8 +1294,13 @@ TclGetTruthValueFromObj(interp, objPtr, boolPtr)
#endif
/*
* Finally, check for the string values like "yes"
+ * and generate error message for non-boolean values.
*/
- return Tcl_GetBooleanFromObj(interp, objPtr, boolPtr);
+ if (SetBooleanFromAny(interp, objPtr) == TCL_OK) {
+ *boolPtr = (int) objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
}
/*
diff --git a/tests/obj.test b/tests/obj.test
index e0eaa2f..8fe6e2b 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: obj.test,v 1.12 2005/04/21 20:24:14 dgp Exp $
+# RCS: @(#) $Id: obj.test,v 1.13 2005/04/22 15:47:00 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -202,10 +202,9 @@ test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} testobj {
test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} testobj {
set result ""
lappend result [testintobj set 1 47]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
+ lappend result [testbooleanobj not 1] ;# must convert to bool
lappend result [testobj type 1]
-} {47 1 {expected boolean value but got "47"} int}
+} {47 0 boolean}
test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} testobj {
set result ""
lappend result [teststringobj set 1 abc]
@@ -221,17 +220,15 @@ test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} test
test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} testobj {
set result ""
lappend result [teststringobj set 1 0xac]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
+ lappend result [testbooleanobj not 1]
lappend result [testobj type 1]
-} {0xac 1 {expected boolean value but got "0xac"} string}
+} {0xac 0 boolean}
test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} testobj {
set result ""
lappend result [teststringobj set 1 5.42]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
+ lappend result [testbooleanobj not 1]
lappend result [testobj type 1]
-} {5.42 1 {expected boolean value but got "5.42"} string}
+} {5.42 0 boolean}
test obj-12.1 {DupBooleanInternalRep} testobj {
set result ""
@@ -242,17 +239,16 @@ test obj-12.1 {DupBooleanInternalRep} testobj {
test obj-13.1 {SetBooleanFromAny, int to boolean special case} testobj {
set result ""
- lappend result [testintobj set 1 1]
+ lappend result [testintobj set 1 1234]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
-} {1 0 boolean}
+} {1234 0 boolean}
test obj-13.2 {SetBooleanFromAny, double to boolean special case} testobj {
set result ""
- lappend result [testdoubleobj set 1 0.0]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
+ lappend result [testdoubleobj set 1 3.14159]
+ lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
-} {0.0 1 {expected boolean value but got "0.0"} double}
+} {3.14159 0 boolean}
test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} testobj {
set result ""
foreach s {yes no true false on off} {
@@ -263,11 +259,11 @@ test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} te
} {0 1 0 1 0 1 boolean}
test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} testobj {
set result ""
- lappend result [testintobj set 1 16]
+ lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
- lappend result [testbooleanobj not 1]
+ lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
-} {16 1 0 boolean}
+} {456 45 0 boolean}
test obj-13.5 {SetBooleanFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 abc]