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

1 files changed, 142 insertions, 147 deletions

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