From 713419b2244c57466ead6674b4c9d30c54dc60d8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 21 Apr 2005 20:24:02 +0000
Subject: * generic/tclGet.c: Radical code simplification.
Converted Tcl_GetFoo() routines into wrappers around
Tcl_GetFooFromObj(). Reduces code duplication, and the resulting
potential for inconsistency.
* generic/tclObj.c: Several changes:
- Fixed Tcl_GetBooleanFromObj to agree with its documentation and
with Tcl_GetBoolean, accepting only "0" and "1" and not other
numeric strings. [Bug 1187123]
- Added new private routine TclGetTruthValueFromObj to perform
the more permissive conversion of numeric values to boolean
that is needed by the [expr] machinery.
* generic/tclInt.h (TclGetTruthValueFromObj): New routine.
* generic/tclExecute.c: Updated callers to call new routine.
* tests/obj.test: Corrected bad tests that actually expected
values like "47" and "0xac" to be accepted as booleans.
---
ChangeLog | 31 ++++--
generic/tclExecute.c | 10 +-
generic/tclGet.c | 87 +++++-----------
generic/tclInt.h | 4 +-
generic/tclObj.c | 289 +++++++++++++++++++++++++--------------------------
tests/obj.test | 34 +++---
6 files changed, 215 insertions(+), 240 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index cbf5ed9..c32e1f6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,18 +2,31 @@
* doc/GetInt.3: Convert argument "string" to "str" to agree with code.
Also clarified a few details on int and double formats.
- * generic/tclGet.c: Radical code simplification. Converted most
+ * generic/tclGet.c: Radical code simplification. Converted
Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj().
Reduces code duplication, and the resulting potential for inconsistency.
- * generic/tclObj.c: Re-ordered error detection code so all values
- with trailing garbage receive a "not an integer" message instead of
- an "integer too large" message.
- Removed inactive code meant to deal with strtoul* routines that fail
- to parse leading signs. All of them do, and if any are detected
- that do not, the correct fix is replacement with compat/strtoul*.c,
- not a lot of special care by the callers.
- Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep.
+ * generic/tclObj.c: Several changes:
+
+ - Re-ordered error detection code so all values with trailing
+ garbage receive a "not an integer" message instead of an
+ "integer too large" message.
+ - Removed inactive code meant to deal with strtoul* routines that
+ fail to parse leading signs. All of them do, and if any are
+ detected that do not, the correct fix is replacement with
+ compat/strtoul*.c, not a lot of special care by the callers.
+ - Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep.
+ - Fixed Tcl_GetBooleanFromObj to agree with its documentation and
+ with Tcl_GetBoolean, accepting only "0" and "1" and not other
+ numeric strings. [Bug 1187123]
+ - Added new private routine TclGetTruthValueFromObj to perform
+ the more permissive conversion of numeric values to boolean
+ that is needed by the [expr] machinery.
+
+ * generic/tclInt.h (TclGetTruthValueFromObj): New routine.
+ * generic/tclExecute.c: Updated callers to call new routine.
+ * tests/obj.test: Corrected bad tests that actually expected
+ values like "47" and "0xac" to be accepted as booleans.
2005-04-20 Don Porter <dgp@users.sourceforge.net>
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8208752..961566c 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.182 2005/04/15 02:38:39 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.183 2005/04/21 20:24:11 dgp Exp $
*/
#include "tclInt.h"
@@ -2539,7 +2539,7 @@ TclExecuteByteCode(interp, codePtr)
*/
int b1;
- result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
+ result = TclGetTruthValueFromObj(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 = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+ result = TclGetTruthValueFromObj((Tcl_Interp *) NULL,
valuePtr, &i1);
i1 = (i1 != 0);
}
@@ -2647,7 +2647,7 @@ TclExecuteByteCode(interp, codePtr)
i2 = (w != W0);
}
} else {
- result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
+ result = TclGetTruthValueFromObj((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 = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL,
+ result = TclGetTruthValueFromObj((Tcl_Interp *)NULL,
valuePtr, &boolvar);
i = (long)boolvar; /* i is long, not int! */
}
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 06f84e0..bad8289 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.11 2005/04/21 14:23:48 dgp Exp $
+ * RCS: @(#) $Id: tclGet.c,v 1.12 2005/04/21 20:24:13 dgp Exp $
*/
#include "tclInt.h"
@@ -44,13 +44,18 @@ Tcl_GetInt(interp, str, intPtr)
int *intPtr; /* Place to store converted result. */
{
Tcl_Obj obj;
+ int code;
obj.refCount = 1;
obj.bytes = (char *) str;
obj.length = strlen(str);
obj.typePtr = NULL;
- return Tcl_GetIntFromObj(interp, &obj, intPtr);
+ code = Tcl_GetIntFromObj(interp, &obj, intPtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
+ }
+ return code;
}
/*
@@ -85,13 +90,18 @@ TclGetLong(interp, str, longPtr)
long *longPtr; /* Place to store converted long result. */
{
Tcl_Obj obj;
+ int code;
obj.refCount = 1;
obj.bytes = (char *) str;
obj.length = strlen(str);
obj.typePtr = NULL;
- return Tcl_GetLongFromObj(interp, &obj, longPtr);
+ code = Tcl_GetLongFromObj(interp, &obj, longPtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
+ }
+ return code;
}
/*
@@ -122,13 +132,18 @@ Tcl_GetDouble(interp, str, doublePtr)
double *doublePtr; /* Place to store converted result. */
{
Tcl_Obj obj;
+ int code;
obj.refCount = 1;
obj.bytes = (char *) str;
obj.length = strlen(str);
obj.typePtr = NULL;
- return Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
+ code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
+ }
+ return code;
}
/*
@@ -160,71 +175,17 @@ Tcl_GetBoolean(interp, str, boolPtr)
int *boolPtr; /* Place to store converted result, which
* will be 0 or 1. */
{
- /*
- * Can't use this (yet) due to Bug 1187123.
- *
Tcl_Obj obj;
+ int code;
obj.refCount = 1;
obj.bytes = (char *) str;
obj.length = strlen(str);
obj.typePtr = NULL;
- return Tcl_GetBooleanFromObj(interp, &obj, boolPtr);
- */
- int i;
- char lowerCase[10], c;
- size_t length;
-
- /*
- * Convert the input string to all lower-case.
- * INTL: This code will work on UTF strings.
- */
-
- for (i = 0; i < 9; i++) {
- c = str[i];
- if (c == 0) {
- break;
- }
- if ((c >= 'A') && (c <= 'Z')) {
- c += (char) ('a' - 'A');
- }
- lowerCase[i] = c;
- }
- lowerCase[i] = 0;
-
- length = strlen(lowerCase);
- c = lowerCase[0];
- if ((c == '0') && (lowerCase[1] == '\0')) {
- *boolPtr = 0;
- } else if ((c == '1') && (lowerCase[1] == '\0')) {
- *boolPtr = 1;
- } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
- *boolPtr = 1;
- } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
- *boolPtr = 0;
- } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
- *boolPtr = 1;
- } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
- *boolPtr = 0;
- } else if ((c == 'o') && (length >= 2)) {
- if (strncmp(lowerCase, "on", length) == 0) {
- *boolPtr = 1;
- } else if (strncmp(lowerCase, "off", length) == 0) {
- *boolPtr = 0;
- } else {
- goto badBoolean;
- }
- } else {
- badBoolean:
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected boolean value but got \"", -1);
- TclAppendLimitedToObj(msg, str, -1, 50, "");
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
- }
- return TCL_ERROR;
+ code = Tcl_GetBooleanFromObj(interp, &obj, boolPtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
- return TCL_OK;
+ return code;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7777cfd..68c2827 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.223 2005/04/19 16:32:55 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.224 2005/04/21 20:24:13 dgp Exp $
*/
#ifndef _TCLINT
@@ -1892,6 +1892,8 @@ 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 4c6b448..96d5227 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.78 2005/04/21 15:49:47 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.79 2005/04/21 20:24:13 dgp Exp $
*/
#include "tclInt.h"
@@ -1234,8 +1234,11 @@ Tcl_SetBooleanObj(objPtr, boolValue)
* Tcl_GetBooleanFromObj --
*
* Attempt to return a boolean from the Tcl object "objPtr". If the
- * object is not already a boolean, an attempt will be made to convert
- * it to one.
+ * 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
@@ -1272,6 +1275,67 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
/*
*----------------------------------------------------------------------
*
+ * TclGetTruthValueFromObj --
+ *
+ * Attempt to return a boolean from the Tcl object "objPtr". This
+ * includes conversion from any of Tcl's numeric types.
+ *
+ * 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:
+ * The intrep of *objPtr may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetTruthValueFromObj(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. */
+{
+ double d;
+ long l;
+ Tcl_WideInt w;
+
+ /*
+ * 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);
+ return TCL_OK;
+ }
+ /*
+ * Value didn't already have a numeric intrep, but perhaps we can
+ * generate one. Try a long value first...
+ */
+ if (Tcl_GetLongFromObj(NULL, objPtr, &l) == TCL_OK) {
+ *boolPtr = (l != 0);
+ return TCL_OK;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ /*
+ * ...then a wide. Check in that order so that we don't promote
+ * anything to wide unnecessarily.
+ */
+ if (Tcl_GetWideIntFromObj(NULL, objPtr, &w) == TCL_OK) {
+ *boolPtr = (w != 0);
+ return TCL_OK;
+ }
+#endif
+ /*
+ * Finally, check for the string values like "yes"
+ */
+ return Tcl_GetBooleanFromObj(interp, objPtr, boolPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* SetBooleanFromAny --
*
* Attempt to generate a boolean internal form for the Tcl object
@@ -1294,69 +1358,87 @@ SetBooleanFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object to convert. */
{
- char *string, *end;
- register char c;
- char lowerCase[8];
- int newBool, length;
- register int i;
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- string = Tcl_GetStringFromObj(objPtr, &length);
+ char *str, lowerCase[6];
+ int i, newBool, length;
/*
- * Use the obvious shortcuts for numerical values; if objPtr is not
- * of numerical type, parse its string rep.
+ * For some "pure" numeric Tcl_ObjTypes (no string rep), we can
+ * determine whether a boolean conversion is possible without
+ * generating the string rep.
*/
- if (objPtr->typePtr == &tclIntType) {
- newBool = (objPtr->internalRep.longValue != 0);
- goto goodBoolean;
- } else if (objPtr->typePtr == &tclDoubleType) {
- newBool = (objPtr->internalRep.doubleValue != 0.0);
- goto goodBoolean;
- } else if (objPtr->typePtr == &tclWideIntType) {
- newBool = (objPtr->internalRep.wideValue != 0);
- goto goodBoolean;
+ if (objPtr->bytes == NULL) {
+ if (objPtr->typePtr == &tclDoubleType) {
+ goto badBoolean;
+ }
+ if (objPtr->typePtr == &tclIntType) {
+ long l = objPtr->internalRep.longValue;
+ switch (l) {
+ case 0: case 1:
+ newBool = (int)l;
+ goto goodBoolean;
+ }
+ goto badBoolean;
+ }
+ if (objPtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt w = objPtr->internalRep.wideValue;
+ switch (w) {
+ case 0: case 1:
+ newBool = (int)w;
+ goto goodBoolean;
+ }
+ goto badBoolean;
+ }
}
/*
* Parse the string as a boolean. We use an implementation here
* that doesn't report errors in interp if interp is NULL.
- *
- * First we define a macro to factor out the to-lower-case code.
- * The len parameter is the maximum number of characters to copy
- * to allow the following comparisons to proceed correctly,
- * including (properly) the trailing \0 character. This is done
- * in multiple places so the number of copying steps is minimised
- * and only performed when needed.
*/
-#define SBFA_TOLOWER(len) \
- for (i=0 ; i<(len) && i<length ; i++) { \
- c = string[i]; \
- if (c & 0x80) { \
- goto badBoolean; \
- } \
- if (Tcl_UniCharIsUpper(UCHAR(c))) { \
- c = (char) Tcl_UniCharToLower(UCHAR(c)); \
- } \
- lowerCase[i] = c; \
- } \
- lowerCase[i] = 0;
-
- switch (string[0]) {
- case 'y': case 'Y':
- /*
- * Copy the string converting its characters to lower case.
- * This also weeds out international characters so we can
- * safely operate on single bytes.
- */
+ str = Tcl_GetStringFromObj(objPtr, &length);
+ if ((length == 0) || (length > 5)) {
+ /* longest valid boolean string rep. is "false" */
+ goto badBoolean;
+ }
- SBFA_TOLOWER(4);
+ switch (str[0]) {
+ case '0':
+ if (length == 1) {
+ newBool = 0;
+ goto goodBoolean;
+ }
+ goto badBoolean;
+ case '1':
+ if (length == 1) {
+ newBool = 1;
+ goto goodBoolean;
+ }
+ goto badBoolean;
+
+ }
+
+ /*
+ * Force to lower case for case-insensitive detection.
+ * Filter out known invalid characters at the same time.
+ */
+ for (i=0; i < length; i++) {
+ char c = str[i];
+ switch (c) {
+ case 'A': case 'E': case 'F': case 'L': case 'N':
+ case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y':
+ lowerCase[i] = c + (char) ('a' - 'A'); break;
+ case 'a': case 'e': case 'f': case 'l': case 'n':
+ case 'o': case 'r': case 's': case 't': case 'u': case 'y':
+ lowerCase[i] = c; break;
+ default:
+ goto badBoolean;
+ }
+ }
+ lowerCase[length] = 0;
+ switch (lowerCase[0]) {
+ case 'y':
/*
* Checking the 'y' is redundant, but makes the code clearer.
*/
@@ -1365,32 +1447,28 @@ SetBooleanFromAny(interp, objPtr)
goto goodBoolean;
}
goto badBoolean;
- case 'n': case 'N':
- SBFA_TOLOWER(3);
+ case 'n':
if (strncmp(lowerCase, "no", (size_t) length) == 0) {
newBool = 0;
goto goodBoolean;
}
goto badBoolean;
- case 't': case 'T':
- SBFA_TOLOWER(5);
+ case 't':
if (strncmp(lowerCase, "true", (size_t) length) == 0) {
newBool = 1;
goto goodBoolean;
}
goto badBoolean;
- case 'f': case 'F':
- SBFA_TOLOWER(6);
+ case 'f':
if (strncmp(lowerCase, "false", (size_t) length) == 0) {
newBool = 0;
goto goodBoolean;
}
goto badBoolean;
- case 'o': case 'O':
+ case 'o':
if (length < 2) {
goto badBoolean;
}
- SBFA_TOLOWER(4);
if (strncmp(lowerCase, "on", (size_t) length) == 0) {
newBool = 1;
goto goodBoolean;
@@ -1399,92 +1477,8 @@ SetBooleanFromAny(interp, objPtr)
goto goodBoolean;
}
goto badBoolean;
-#undef SBFA_TOLOWER
- case '0':
- if (string[1] == '\0') {
- newBool = 0;
- goto goodBoolean;
- }
- goto parseNumeric;
- case '1':
- if (string[1] == '\0') {
- newBool = 1;
- goto goodBoolean;
- }
- /* deliberate fall-through */
default:
- parseNumeric:
- {
- double dbl;
- /*
- * Boolean values can be extracted from ints or doubles.
- * Note that we don't use strtoul or strtoull here because
- * we don't care about what the value is, just whether it
- * is equal to zero or not.
- */
-#ifdef TCL_WIDE_INT_IS_LONG
- newBool = strtol(string, &end, 0);
- if (end != string) {
- /*
- * Make sure the string has no garbage after the end of
- * the int.
- */
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO only */
- end++;
- }
- if (end == (string+length)) {
- newBool = (newBool != 0);
- goto goodBoolean;
- }
- }
-#else /* !TCL_WIDE_INT_IS_LONG */
- Tcl_WideInt wide = strtoll(string, &end, 0);
- if (end != string) {
- /*
- * Make sure the string has no garbage after the end of
- * the wide int.
- */
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO only */
- end++;
- }
- if (end == (string+length)) {
- newBool = (wide != Tcl_LongAsWide(0));
- goto goodBoolean;
- }
- }
-#endif /* TCL_WIDE_INT_IS_LONG */
- /*
- * Still might be a string containing the characters
- * representing an int or double that wasn't handled
- * above. This would be a string like "27" or "1.0" that
- * is non-zero and not "1". Such a string would result in
- * the boolean value true. We try converting to double. If
- * that succeeds and the resulting double is non-zero, we
- * have a "true". Note that numbers can't have embedded
- * NULLs.
- */
-
- dbl = strtod(string, &end);
- if (end == string) {
- goto badBoolean;
- }
-
- /*
- * Make sure the string has no garbage after the end of
- * the double.
- */
-
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO only */
- end++;
- }
- if (end != (string+length)) {
- goto badBoolean;
- }
- newBool = (dbl != 0.0);
- }
+ goto badBoolean;
}
/*
@@ -1503,7 +1497,8 @@ SetBooleanFromAny(interp, objPtr)
if (interp != NULL) {
Tcl_Obj *msg =
Tcl_NewStringObj("expected boolean value but got \"", -1);
- TclAppendLimitedToObj(msg, string, length, 50, "");
+ str = Tcl_GetStringFromObj(objPtr, &length);
+ TclAppendLimitedToObj(msg, str, length, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
}
diff --git a/tests/obj.test b/tests/obj.test
index 4d7a86b..e0eaa2f 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.11 2004/09/10 21:29:42 dkf Exp $
+# RCS: @(#) $Id: obj.test,v 1.12 2005/04/21 20:24:14 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -202,9 +202,10 @@ 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 [testbooleanobj not 1] ;# must convert to bool
+ lappend result [catch {testbooleanobj not 1} msg]
+ lappend result $msg
lappend result [testobj type 1]
-} {47 0 boolean}
+} {47 1 {expected boolean value but got "47"} int}
test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} testobj {
set result ""
lappend result [teststringobj set 1 abc]
@@ -220,15 +221,17 @@ 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 [testbooleanobj not 1]
+ lappend result [catch {testbooleanobj not 1} msg]
+ lappend result $msg
lappend result [testobj type 1]
-} {0xac 0 boolean}
+} {0xac 1 {expected boolean value but got "0xac"} string}
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 [catch {testbooleanobj not 1} msg]
+ lappend result $msg
lappend result [testobj type 1]
-} {5.42 0 boolean}
+} {5.42 1 {expected boolean value but got "5.42"} string}
test obj-12.1 {DupBooleanInternalRep} testobj {
set result ""
@@ -239,16 +242,17 @@ test obj-12.1 {DupBooleanInternalRep} testobj {
test obj-13.1 {SetBooleanFromAny, int to boolean special case} testobj {
set result ""
- lappend result [testintobj set 1 1234]
+ lappend result [testintobj set 1 1]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
-} {1234 0 boolean}
+} {1 0 boolean}
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 [testdoubleobj set 1 0.0]
+ lappend result [catch {testbooleanobj not 1} msg]
+ lappend result $msg
lappend result [testobj type 1]
-} {3.14159 0 boolean}
+} {0.0 1 {expected boolean value but got "0.0"} double}
test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} testobj {
set result ""
foreach s {yes no true false on off} {
@@ -259,11 +263,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 456]
+ lappend result [testintobj set 1 16]
lappend result [testintobj div10 1]
- lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
+ lappend result [testbooleanobj not 1]
lappend result [testobj type 1]
-} {456 45 0 boolean}
+} {16 1 0 boolean}
test obj-13.5 {SetBooleanFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 abc]
--
cgit v0.12