diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | generic/tclInt.h | 19 | ||||
| -rw-r--r-- | generic/tclObj.c | 65 | ||||
| -rw-r--r-- | tests/obj.test | 25 |
4 files changed, 91 insertions, 33 deletions
@@ -1,3 +1,16 @@ +2005-05-18 Don Porter <dgp@users.sourceforge.net> + + * generic/tclInt.h: Revision to the "boolean" Tcl_ObjType, so + * generic/tclObj.c: that only string values like "yes" and "false" + * tests/obj.test: are kept as the "boolean" Tcl_ObjType. The + string values "0" and "1" are kept as "int" Tcl_ObjType, which also + produce quick calls to Tcl_GetBooleanFromObj(). Since this internal + change means a Tcl_ConvertToType to a "boolean" Tcl_ObjType might + not produce a Tcl_Obj of type "boolean", the registration of the + "boolean" type is also removed. + ***POTENTIAL INCOMPATIBILITY*** + For callers of Tcl_GetObjType on the type name "boolean". + 2005-05-17 Don Porter <dgp@users.sourceforge.net> * generic/tclObj.c (TclInitObjSubsystem): Removed the @@ -9,6 +22,8 @@ Tcl_ConvertToType(). None of the types above can support a Tcl_ConvertToType() call; they panic. Better not to offer something than to lead users into a panic. + ***POTENTIAL INCOMPATIBILITY*** + For callers of Tcl_GetObjType on the type names listed above. 2005-05-15 Kevin Kenny <kennykb@users.sourceforge.net> diff --git a/generic/tclInt.h b/generic/tclInt.h index 0a05edb..0aa7f5a 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.229 2005/05/10 18:34:42 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.230 2005/05/18 15:43:36 dgp Exp $ */ #ifndef _TCLINT @@ -2782,9 +2782,15 @@ MODULE_SCOPE void TclBNInitBignumFromLong( mp_int* bignum, long initVal ); #define TclSetLongObj(objPtr, l) \ TclSetIntObj((objPtr), (l)) +/* + * NOTE: There is to be no such thing as a "pure" boolean. + * Boolean values set programmatically go straight to being + * "int" Tcl_Obj's, with value 0 or 1. The only "boolean" + * Tcl_Obj's shall be those holding the cached boolean value + * of strings like: "yes", "no", "true", "false", "on", "off". + */ #define TclSetBooleanObj(objPtr, b) \ - TclSetIntObj((objPtr), ((b)? 1 : 0));\ - (objPtr)->typePtr = &tclBooleanType + TclSetIntObj((objPtr), ((b)? 1 : 0)); #define TclSetWideIntObj(objPtr, w) \ TclInvalidateStringRep(objPtr);\ @@ -2832,9 +2838,12 @@ MODULE_SCOPE void TclBNInitBignumFromLong( mp_int* bignum, long initVal ); #define TclNewLongObj(objPtr, l) \ TclNewIntObj((objPtr), (l)) +/* + * NOTE: There is to be no such thing as a "pure" boolean. + * See comment above TclSetBooleanObj macro above. + */ #define TclNewBooleanObj(objPtr, b) \ - TclNewIntObj((objPtr), ((b)? 1 : 0));\ - (objPtr)->typePtr = &tclBooleanType + TclNewIntObj((objPtr), ((b)? 1 : 0)) #define TclNewWideIntObj(objPtr, w) \ TclIncrObjsAllocated(); \ diff --git a/generic/tclObj.c b/generic/tclObj.c index 88d31f0..ce29a7a 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -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: tclObj.c,v 1.84 2005/05/17 21:29:17 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.85 2005/05/18 15:43:38 dgp Exp $ */ #include "tclInt.h" @@ -375,7 +375,6 @@ TclInitObjSubsystem() Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); - Tcl_RegisterObjType(&tclBooleanType); Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); @@ -1225,7 +1224,7 @@ Tcl_DbNewBooleanObj(boolValue, file, line) objPtr->bytes = NULL; objPtr->internalRep.longValue = (boolValue? 1 : 0); - objPtr->typePtr = &tclBooleanType; + objPtr->typePtr = &tclIntType; return objPtr; } @@ -1301,19 +1300,52 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) double d; long l; + /* + * The flow through this routine is "optimized" to avoid the + * generation of string rep. for "pure" numeric values. However, + * once the string rep is generated it's fairly inefficient at + * determining a string is *not* a valid boolean. It has to + * scan the string as many as four times (ruling out "double", + * "long", "wideint", and "boolean" in turn) to figure out that + * an invalid boolean value is stored in objPtr->bytes. + */ + + if (objPtr->typePtr == &tclIntType) { + *boolPtr = (int) (objPtr->internalRep.longValue != 0); + return TCL_OK; + } if (objPtr->typePtr == &tclBooleanType) { *boolPtr = (int) objPtr->internalRep.longValue; return TCL_OK; } + if (objPtr->typePtr == &tclWideIntType) { + *boolPtr = (int) (objPtr->internalRep.wideValue != 0); + return TCL_OK; + } + + /* + * Caution: Don't be tempted to check directly for the + * "double" Tcl_ObjType and then compare the intrep to 0.0. + * This isn't reliable because a "double" Tcl_ObjType can + * hold the NaN value. Use the API Tcl_GetDoubleFromObj, + * which does the checking for us. + */ + /* - * The following call retrieves a numeric value without shimmering - * away any existing numeric intrep Tcl_ObjTypes. + * The following call retrieves a numeric value without + * generating the string rep of a double. */ if (Tcl_GetDoubleFromObj(NULL, objPtr, &d) == TCL_OK) { *boolPtr = (d != 0.0); - /* Attempt shimmer to "boolean" objType */ - SetBooleanFromAny(NULL, objPtr); + /* Tcl_GetDoubleFromObj() will succeed on the strings "0" + * and "1", but we'd rather keep those values around as + * a better objType for boolean value. Following call + * will shimmer appropriately. + */ + if (objPtr->bytes != NULL) { + SetBooleanFromAny(NULL, objPtr); + } return TCL_OK; } /* @@ -1387,11 +1419,9 @@ SetBooleanFromAny(interp, objPtr) goto badBoolean; } if (objPtr->typePtr == &tclIntType) { - long l = objPtr->internalRep.longValue; - switch (l) { + switch (objPtr->internalRep.longValue) { case 0: case 1: - newBool = (int)l; - goto goodBoolean; + return TCL_OK; } goto badBoolean; } @@ -1400,7 +1430,7 @@ SetBooleanFromAny(interp, objPtr) switch (w) { case 0: case 1: newBool = (int)w; - goto goodBoolean; + goto numericBoolean; } goto badBoolean; } @@ -1421,16 +1451,15 @@ SetBooleanFromAny(interp, objPtr) case '0': if (length == 1) { newBool = 0; - goto goodBoolean; + goto numericBoolean; } goto badBoolean; case '1': if (length == 1) { newBool = 1; - goto goodBoolean; + goto numericBoolean; } goto badBoolean; - } /* @@ -1518,6 +1547,12 @@ SetBooleanFromAny(interp, objPtr) Tcl_SetObjResult(interp, msg); } return TCL_ERROR; + + numericBoolean: + TclFreeIntRep(objPtr); + objPtr->internalRep.longValue = newBool; + objPtr->typePtr = &tclIntType; + return TCL_OK; } /* diff --git a/tests/obj.test b/tests/obj.test index dfbad05..fb7e1d1 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.15 2005/05/17 21:29:18 dgp Exp $ +# RCS: @(#) $Id: obj.test,v 1.16 2005/05/18 15:43:38 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -48,7 +48,6 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes foreach {t} { {array search} bignum - boolean bytearray bytecode cmdName @@ -177,7 +176,7 @@ test obj-9.1 {Tcl_NewBooleanObj} testobj { lappend result [testbooleanobj set 1 0] lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} 0 boolean 2} +} {{} 0 int 2} test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} testobj { set result "" @@ -186,7 +185,7 @@ test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} testobj { lappend result [testbooleanobj set 1 0] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} {} 0 boolean 2} +} {{} {} 0 int 2} test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] @@ -194,7 +193,7 @@ test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} testobj { lappend result [testbooleanobj set 1 1] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} 98765 1 boolean 2} +} {{} 98765 1 int 2} test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} testobj { set result "" @@ -206,7 +205,7 @@ test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} testobj { lappend result [testintobj set 1 47] lappend result [testbooleanobj not 1] ;# must convert to bool lappend result [testobj type 1] -} {47 0 boolean} +} {47 0 int} test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} testobj { set result "" lappend result [teststringobj set 1 abc] @@ -224,13 +223,13 @@ test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} testobj { lappend result [teststringobj set 1 0xac] lappend result [testbooleanobj not 1] lappend result [testobj type 1] -} {0xac 0 boolean} +} {0xac 0 int} test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} testobj { set result "" lappend result [teststringobj set 1 5.42] lappend result [testbooleanobj not 1] lappend result [testobj type 1] -} {5.42 0 boolean} +} {5.42 0 int} test obj-12.1 {DupBooleanInternalRep} testobj { set result "" @@ -244,13 +243,13 @@ test obj-13.1 {SetBooleanFromAny, int to boolean special case} testobj { lappend result [testintobj set 1 1234] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] -} {1234 0 boolean} +} {1234 0 int} test obj-13.2 {SetBooleanFromAny, double to boolean special case} testobj { set result "" lappend result [testdoubleobj set 1 3.14159] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] -} {3.14159 0 boolean} +} {3.14159 0 int} test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} testobj { set result "" foreach s {yes no true false on off} { @@ -258,14 +257,14 @@ test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} te lappend result [testbooleanobj not 1] } lappend result [testobj type 1] -} {0 1 0 1 0 1 boolean} +} {0 1 0 1 0 1 int} test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} testobj { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] -} {456 45 0 boolean} +} {456 45 0 int} test obj-13.5 {SetBooleanFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 abc] @@ -573,7 +572,7 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj { lappend result [testobj type 2] lappend result [testobj refcount 1] lappend result [testobj refcount 2] -} {{} 1024 1024 int 4 4 0 boolean 3 2} +} {{} 1024 1024 int 4 4 0 int 3 2} test obj-31.1 {regenerate string rep of "end"} testobj { |