summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c65
1 files changed, 50 insertions, 15 deletions
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;
}
/*