summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog15
-rw-r--r--generic/tclInt.h19
-rw-r--r--generic/tclObj.c65
-rw-r--r--tests/obj.test25
4 files changed, 91 insertions, 33 deletions
diff --git a/ChangeLog b/ChangeLog
index 2f081b3..1a6eab0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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 {