diff options
| -rw-r--r-- | ChangeLog | 26 | ||||
| -rw-r--r-- | doc/BoolObj.3 | 46 | ||||
| -rw-r--r-- | generic/tclBasic.c | 6 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 6 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 4 | ||||
| -rw-r--r-- | generic/tclExecute.c | 10 | ||||
| -rw-r--r-- | generic/tclGet.c | 7 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclObj.c | 62 | ||||
| -rw-r--r-- | tests/obj.test | 34 |
10 files changed, 103 insertions, 102 deletions
@@ -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] |