1 files changed, 190 insertions, 251 deletions

diff --git a/generic/tclObj.c b/generic/tclObj.c
index 51b84bc..1861cb3 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.72.2.10 2005/04/10 23:14:54 kennykb Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.72.2.11 2005/04/25 21:37:22 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -1284,9 +1284,8 @@ 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.
+ *	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
@@ -1294,8 +1293,7 @@ Tcl_SetBooleanObj(objPtr, boolValue)
  *	result unless "interp" is NULL.
  *
  * Side effects:
- *	If the object is not already a boolean, the conversion will free
- *	any old internal representation.
+ *	The intrep of *objPtr may be changed.
  *
  *----------------------------------------------------------------------
  */
@@ -1306,18 +1304,54 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
     register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
     register int *boolPtr;	/* Place to store resulting boolean. */
 {
-    register int result;
+    double d;
+    long l;
 
     if (objPtr->typePtr == &tclBooleanType) {
-	result = TCL_OK;
-    } else {
-	result = SetBooleanFromAny(interp, objPtr);
+	*boolPtr = (int) objPtr->internalRep.longValue;
+	return TCL_OK;
     }
+    /* 
+     * 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);
 
-    if (result == TCL_OK) {
+	/* Attempt shimmer to "boolean" objType */
+	SetBooleanFromAny(NULL, objPtr); 
+	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
+    else {
+	Tcl_WideInt w;
+	/*
+	 * ...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"
+     * and generate error message for non-boolean values.
+     */
+    if (SetBooleanFromAny(interp, objPtr) == TCL_OK) {
 	*boolPtr = (int) objPtr->internalRep.longValue;
+	return TCL_OK;
     }
-    return result;
+    return TCL_ERROR;
 }
 
 /*
@@ -1345,69 +1379,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;
+    }
+
+    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;
 
-	SBFA_TOLOWER(4);
+    }
+
+    /*
+     * 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.
 	 */
@@ -1416,32 +1468,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;
@@ -1450,92 +1498,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 = TclStrToD(string, (CONST char **) &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;
     }
 
     /*
@@ -1554,7 +1518,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);
     }
@@ -1761,21 +1726,24 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
 	result = TCL_OK;
     } else if (objPtr->typePtr == &tclIntType) {
 	*dblPtr = objPtr->internalRep.longValue;
-	result = TCL_OK;
-    } else {
-	result = SetDoubleFromAny(interp, objPtr);
-	if (result == TCL_OK) {
-	    *dblPtr = objPtr->internalRep.doubleValue;
-	}
+	return TCL_OK;
+    } else if (objPtr->typePtr == &tclWideIntType) {
+	*dblPtr = (double) objPtr->internalRep.wideValue;
+	return TCL_OK;
     }
-    if ( result == TCL_OK && IS_NAN( *dblPtr ) ) {
-	if ( interp != NULL ) {
-	    Tcl_SetObjResult
-		( interp,
-		  Tcl_NewStringObj( "floating point value is Not a Number",
-				    -1 ) );
+
+    result = SetDoubleFromAny(interp, objPtr);
+    if ( result == TCL_OK ) {
+	if ( IS_NAN( *dblPtr ) ) {
+	    if ( interp != NULL ) {
+		Tcl_SetObjResult
+		    ( interp,
+		      Tcl_NewStringObj( "floating point value is Not a Number",
+					-1 ) );
+	    }
+	    return TCL_ERROR;
 	}
-	result = TCL_ERROR;
+	*dblPtr = objPtr->internalRep.doubleValue;
     }
     return result;
 }
@@ -1847,6 +1815,13 @@ SetDoubleFromAny(interp, objPtr)
 	goto badDouble;
     }
 
+    if (errno != 0) {
+	if (interp != NULL) {
+	    TclExprFloatError(interp, newDouble);
+	}
+	return TCL_ERROR;
+    }
+
     /*
      * The conversion to double succeeded. Free the old internalRep before
      * setting the new one. We do this as late as possible to allow the
@@ -2012,15 +1987,14 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
     register Tcl_Obj *objPtr;	/* The object from which to get a int. */
     register int *intPtr;	/* Place to store resulting int. */
 {
-    register long l = 0;
     int result;
+    Tcl_WideInt w = 0;
 
     /* If the object isn't already an integer of any width, try to
      * convert it to one.
      */
 
-    if (objPtr->typePtr != &tclIntType
-	    && objPtr->typePtr != &tclWideIntType) {
+    if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
 	result = SetIntOrWideFromAny(interp, objPtr);
 	if (result != TCL_OK) {
 	    return result;
@@ -2029,45 +2003,26 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
 
     /* Object should now be either int or wide. Get its value. */
 
-    if (objPtr->typePtr == &tclIntType) {
-	l = objPtr->internalRep.longValue;
-    } else if (objPtr->typePtr == &tclWideIntType) {
 #ifndef TCL_WIDE_INT_IS_LONG
-	/*
-	 * If the object is already a wide integer, don't convert it.
-	 * This code allows for any integer in the range -ULONG_MAX to
-	 * ULONG_MAX to be converted to a long, ignoring overflow.
-	 * The rule preserves existing semantics for conversion of
-	 * integers on input, but avoids inadvertent demotion of
-	 * wide integers to 32-bit ones in the internal rep.
-	 */
-	Tcl_WideInt w = objPtr->internalRep.wideValue;
-	if (w >= -(Tcl_WideInt)(ULONG_MAX)
-		&& w <= (Tcl_WideInt)(ULONG_MAX)) {
-	    l = Tcl_WideAsLong(w);
-	} else {
-	    goto tooBig;
-	}
-#else
-	l = objPtr->internalRep.longValue;
+    if (objPtr->typePtr == &tclWideIntType) {
+	w = objPtr->internalRep.wideValue;
+    } else
 #endif
-    } else {
-	Tcl_Panic("string->integer conversion failed to convert the obj.");
+    {
+	w = Tcl_LongAsWide(objPtr->internalRep.longValue);
     }
 
-    if (((long)((int)l)) == l) {
-	*intPtr = (int)l;
-	return TCL_OK;
-    }
-#ifndef TCL_WIDE_INT_IS_LONG
-  tooBig:
-#endif
-    if (interp != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+    if ((LLONG_MAX > UINT_MAX)
+	    && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"integer value too large to represent as non-long integer",
 		-1));
+	}
+	return TCL_ERROR;
     }
-    return TCL_ERROR;
+    *intPtr = (int)w;
+    return TCL_OK;
 }
 
 /*
@@ -2138,7 +2093,6 @@ SetIntOrWideFromAny(interp, objPtr)
     register char *p;
     unsigned long newLong;
     int isNegative = 0;
-    int isWide = 0;
 
     /*
      * Get the string representation. Make it up-to-date if necessary.
@@ -2150,8 +2104,9 @@ SetIntOrWideFromAny(interp, objPtr)
      * Now parse "objPtr"s string as an int. We use an implementation here
      * that doesn't report errors in interp if interp is NULL. Note: use
      * strtoul instead of strtol for integer conversions to allow full-size
-     * unsigned numbers, but don't depend on strtoul to handle sign
-     * characters; it won't in some implementations.
+     * unsigned numbers.  We parse the leading space and sign ourselves so
+     * we can tell the difference between apparently positive and negative
+     * values.  
      */
 
     errno = 0;
@@ -2180,14 +2135,6 @@ SetIntOrWideFromAny(interp, objPtr)
     if (end == p) {
 	goto badInteger;
     }
-    if (errno == ERANGE) {
-	if (interp != NULL) {
-	    CONST char *s = "integer value too large to represent";
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
-	}
-	return TCL_ERROR;
-    }
 
     /*
      * Make sure that the string has no garbage after the end of the int.
@@ -2201,17 +2148,14 @@ SetIntOrWideFromAny(interp, objPtr)
 	goto badInteger;
     }
 
-    /*
-     * If the resulting integer will exceed the range of a long,
-     * put it into a wide instead.  (Tcl Bug #868489)
-     */
-
-#ifndef TCL_WIDE_INT_IS_LONG
-    if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1)
-	    || (!isNegative && newLong > LONG_MAX)) {
-	isWide = 1;
+    if (errno == ERANGE) {
+	if (interp != NULL) {
+	    CONST char *s = "integer value too large to represent";
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+	}
+	return TCL_ERROR;
     }
-#endif
 
     /*
      * The conversion to int succeeded. Free the old internalRep before
@@ -2221,11 +2165,20 @@ SetIntOrWideFromAny(interp, objPtr)
      */
 
     TclFreeIntRep(objPtr);
-    if (isWide) {
+#ifndef TCL_WIDE_INT_IS_LONG
+    /*
+     * If the resulting integer will exceed the range of a long,
+     * put it into a wide instead.  (Tcl Bug #868489)
+     */
+
+    if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1)
+	    || (!isNegative && newLong > LONG_MAX)) {
 	objPtr->internalRep.wideValue =
 		(isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong);
 	objPtr->typePtr = &tclWideIntType;
-    } else {
+    } else
+#endif
+    {
 	objPtr->internalRep.longValue =
 		(isNegative ? -(long)newLong : (long)newLong);
 	objPtr->typePtr = &tclIntType;
@@ -2528,25 +2481,11 @@ SetWideIntFromAny(interp, objPtr)
      * Now parse "objPtr"s string as an int. We use an implementation here
      * that doesn't report errors in interp if interp is NULL. Note: use
      * strtoull instead of strtoll for integer conversions to allow full-size
-     * unsigned numbers, but don't depend on strtoull to handle sign
-     * characters; it won't in some implementations.
+     * unsigned numbers.
      */
 
     errno = 0;
-#ifdef TCL_STRTOUL_SIGN_CHECK
-    for (; isspace(UCHAR(*p)) ; p++) {	/* INTL: ISO space. */
-	/* Empty loop body. */
-    }
-    if (*p == '-') {
-	p++;
-	newWide = -((Tcl_WideInt)strtoull(p, &end, 0));
-    } else if (*p == '+') {
-	p++;
-	newWide = strtoull(p, &end, 0);
-    } else
-#else
-	newWide = strtoull(p, &end, 0);
-#endif
+    newWide = strtoull(p, &end, 0);
     if (end == p) {
 	badInteger:
 	if (interp != NULL) {
@@ -2559,14 +2498,6 @@ SetWideIntFromAny(interp, objPtr)
 	}
 	return TCL_ERROR;
     }
-    if (errno == ERANGE) {
-	if (interp != NULL) {
-	    CONST char *s = "integer value too large to represent";
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
-	}
-	return TCL_ERROR;
-    }
 
     /*
      * Make sure that the string has no garbage after the end of the int.
@@ -2580,6 +2511,14 @@ SetWideIntFromAny(interp, objPtr)
 	goto badInteger;
     }
 
+    if (errno == ERANGE) {
+	if (interp != NULL) {
+	    CONST char *s = "integer value too large to represent";
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
     /*
      * The conversion to int succeeded. Free the old internalRep before
      * setting the new one. We do this as late as possible to allow the