* 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.

4 files changed, 174 insertions, 216 deletions

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);
     }