* docs/BoolObj.3: added description of valid string reps for a

	boolean object [Bug 584794]
	* generic/tclObj.c: optimised Tcl_GetBooleanFromObj and
	SetBooleanFromAny to avoid parsing the string rep when it can be
	avoided [Bugs 584650, 472576]

3 files changed, 132 insertions, 98 deletions

diff --git a/ChangeLog b/ChangeLog
index 6fd1ee9..137929c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
 2002-08-07  Miguel Sofer  <msofer@users.sourceforge.net>
 
+	* docs/BoolObj.3: added description of valid string reps for a
+	boolean object [Bug 584794]
+	* generic/tclObj.c: optimised Tcl_GetBooleanFromObj and
+	SetBooleanFromAny to avoid parsing the string rep when it can be
+	avoided [Bugs 584650, 472576]
+	
+2002-08-07  Miguel Sofer  <msofer@users.sourceforge.net>
+
 	* generic/tclCompile.h:
 	* generic/tclObj.c: making tclCmdNameType static ([Bug 584567],
 	Don Porter).
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index 2306350..c6409dc 100644
--- a/doc/BoolObj.3
+++ b/doc/BoolObj.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: BoolObj.3,v 1.2 1998/09/14 18:39:46 stanton Exp $
+'\" RCS: @(#) $Id: BoolObj.3,v 1.3 2002/08/07 17:13:56 msofer Exp $
 '\" 
 .so man.macros
 .TH Tcl_BooleanObj 3 8.0 Tcl "Tcl Library Procedures"
@@ -75,6 +75,12 @@ Otherwise, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR
 and stores the boolean value in the address given by \fIboolPtr\fR.
 If the object is not already a boolean object,
 the conversion will free any old internal representation.
+Objects having a string representation equal to any of \fB0\fR,
+\fBfalse\fR, \fBno\fR, or \fBoff\fR have a boolean value 0; if the
+string representation is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or
+\fBon\fR the boolean value is 1.
+Any of these string values may be abbreviated, and upper-case spellings
+are also acceptable.
 
 .SH "SEE ALSO"
 Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 2fb036c..7ecf030 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.37 2002/08/07 15:50:29 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.38 2002/08/07 17:13:56 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1074,7 +1074,12 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
 {
     register int result;
 
-    result = SetBooleanFromAny(interp, objPtr);
+    if (objPtr->typePtr == &tclBooleanType) {
+	result = TCL_OK;
+    } else {
+	result = SetBooleanFromAny(interp, objPtr);
+    }
+
     if (result == TCL_OK) {
 	*boolPtr = (int) objPtr->internalRep.longValue;
     }
@@ -1116,123 +1121,138 @@ SetBooleanFromAny(interp, objPtr)
     /*
      * Get the string representation. Make it up-to-date if necessary.
      */
-
+    
     string = Tcl_GetStringFromObj(objPtr, &length);
 
     /*
-     * Copy the string converting its characters to lower case.
+     * Use the obvious shortcuts for numerical values; if objPtr is not
+     * of numerical type, parse its string rep.
      */
-
-    for (i = 0;  (i < 9) && (i < length);  i++) {
-	c = string[i];
+	
+    if (objPtr->typePtr == &tclIntType) {
+	newBool = (objPtr->internalRep.longValue != 0);
+    } else if (objPtr->typePtr == &tclDoubleType) {
+	newBool = (objPtr->internalRep.doubleValue != 0.0);
+#ifndef TCL_WIDE_INT_IS_LONG
+    } else if (objPtr->typePtr == &tclWideIntType) {
+	newBool = (objPtr->internalRep.wideValue != Tcl_LongAsWide(0));
+#endif /* TCL_WIDE_INT_IS_LONG */
+    } else {
 	/*
-	 * Weed out international characters so we can safely operate
-	 * on single bytes.
+	 * Copy the string converting its characters to lower case.
 	 */
-
-	if (c & 0x80) {
-	    goto badBoolean;
-	}
-	if (Tcl_UniCharIsUpper(UCHAR(c))) {
-	    c = (char) Tcl_UniCharToLower(UCHAR(c));
+	
+	for (i = 0;  (i < 9) && (i < length);  i++) {
+	    c = string[i];
+	    /*
+	     * Weed out international characters so we can safely operate
+	     * on single bytes.
+	     */
+	    
+	    if (c & 0x80) {
+		goto badBoolean;
+	    }
+	    if (Tcl_UniCharIsUpper(UCHAR(c))) {
+		c = (char) Tcl_UniCharToLower(UCHAR(c));
+	    }
+	    lowerCase[i] = c;
 	}
-	lowerCase[i] = c;
-    }
-    lowerCase[i] = 0;
-
-    /*
-     * Parse the string as a boolean. We use an implementation here that
-     * doesn't report errors in interp if interp is NULL.
-     */
-
-    c = lowerCase[0];
-    if ((c == '0') && (lowerCase[1] == '\0')) {
-	newBool = 0;
-    } else if ((c == '1') && (lowerCase[1] == '\0')) {
-	newBool = 1;
-    } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
-	newBool = 1;
-    } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
-	newBool = 0;
-    } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
-	newBool = 1;
-    } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
-	newBool = 0;
-    } else if ((c == 'o') && (length >= 2)) {
-	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+	lowerCase[i] = 0;
+	
+	/*
+	 * Parse the string as a boolean. We use an implementation here that
+	 * doesn't report errors in interp if interp is NULL.
+	 */
+	
+	c = lowerCase[0];
+	if ((c == '0') && (lowerCase[1] == '\0')) {
+	    newBool = 0;
+	} else if ((c == '1') && (lowerCase[1] == '\0')) {
+	    newBool = 1;
+	} else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
+	    newBool = 1;
+	} else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
+	    newBool = 0;
+	} else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
 	    newBool = 1;
-	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+	} else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
 	    newBool = 0;
+	} else if ((c == 'o') && (length >= 2)) {
+	    if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+		newBool = 1;
+	    } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+		newBool = 0;
+	    } else {
+		goto badBoolean;
+	    }
 	} else {
-	    goto badBoolean;
-	}
-    } else {
-	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) {
+	    double dbl;
 	    /*
-	     * Make sure the string has no garbage after the end of
-	     * the int.
+	     * 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.
 	     */
-	    while ((end < (string+length))
-		   && isspace(UCHAR(*end))) { /* INTL: ISO only */
-		end++;
-	    }
-	    if (end == (string+length)) {
-		newBool = (newBool != 0);
-		goto goodBoolean;
+#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) {
+	    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 */
 	    /*
-	     * Make sure the string has no garbage after the end of
-	     * the wide int.
+	     * 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)) {
-		newBool = (wide != Tcl_LongAsWide(0));
-		goto goodBoolean;
+	    if (end != (string+length)) {
+		goto badBoolean;
 	    }
+	    newBool = (dbl != 0.0);
 	}
-#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);
     }
 
     /*