2005-12-19 Don Porter <dgp@users.sourceforge.net>

        * generic/tclCmdMZ.c:   Modified [string is double] to use
        * tests/string.test:    TclParseNumber() to parse trailing whitespace.
        Ensures consistency, and makes it easier to cleanup after invalid
        internal reps left behind by parsing [Bugs 1360432 1382287].

        * generic/tclParseExpr.c:       Added TCL_PARSE_NO_WHITESPACE to
        * generic/tclScan.c:    TclParseNumber() calls since [scan] and
        * tests/scan.test:      [expr] parsing don't want spaces in parsed
        numbers.

        * generic/tclInt.h:     Added TCL_PARSE_NO_WHITESPACE flag to the
        * generic/tclStrToD.c:  TclParseNumber() interface.

8 files changed, 66 insertions, 29 deletions

diff --git a/ChangeLog b/ChangeLog
index f645c5d..c1027a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2005-12-19  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclCmdMZ.c:	Modified [string is double] to use
+	* tests/string.test:	TclParseNumber() to parse trailing whitespace.
+	Ensures consistency, and makes it easier to cleanup after invalid
+	internal reps left behind by parsing [Bugs 1360432 1382287].
+	
+	* generic/tclParseExpr.c:	Added TCL_PARSE_NO_WHITESPACE to
+	* generic/tclScan.c:	TclParseNumber() calls since [scan] and
+	* tests/scan.test:	[expr] parsing don't want spaces in parsed
+	numbers.
+
+	* generic/tclInt.h:	Added TCL_PARSE_NO_WHITESPACE flag to the
+	* generic/tclStrToD.c:	TclParseNumber() interface.
+
 2005-12-19  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>
 
 	* doc/Tcl.n: Clarify what is going on in variable substitution
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1472f43..d955691 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.133 2005/11/04 22:38:38 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.134 2005/12/19 19:03:16 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1544,8 +1544,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 		failat = 0;
 	    } else {
 		failat = stop - string1;
-		string1 = stop;
-		chcomp = Tcl_UniCharIsSpace;
+		if (stop < end) {
+		    result = 0;
+		    TclFreeIntRep(objPtr);
+		    objPtr->typePtr = NULL;
+		}
 	    }
 	    break;
 	}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b183bca..4a0590a 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.262 2005/12/13 22:43:17 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.263 2005/12/19 19:03:17 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -1906,6 +1906,8 @@ typedef struct ProcessGlobalValue {
 				/* Disable floating point parsing */
 #define TCL_PARSE_SCAN_PREFIXES		16
 				/* Use [scan] rules dealing with 0? prefixes */
+#define TCL_PARSE_NO_WHITESPACE		32
+				/* Reject leading/trailing whitespace */
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index ae1e2b2..688447b 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.31 2005/12/13 22:43:18 kennykb Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.32 2005/12/19 19:03:17 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1616,7 +1616,7 @@ GetLexeme(
 	CONST char *end = infoPtr->lastChar;
 	CONST char* end2;
 	int code = TclParseNumber(NULL, NULL, NULL, src, (int)(end-src),
-		&end2, 0);
+		&end2, TCL_PARSE_NO_WHITESPACE);
 
 	if (code == TCL_OK) {
 	    length = end2-src;
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 268353c..91909c8 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclScan.c,v 1.22 2005/11/12 04:08:05 dgp Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.23 2005/12/19 19:03:17 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -630,7 +630,7 @@ Tcl_ScanObjCmd(
     objIndex = 0;
     nconversions = 0;
     while (*format != '\0') {
-	int parseFlag = 0;
+	int parseFlag = TCL_PARSE_NO_WHITESPACE;
 	format += Tcl_UtfToUniChar(format, &ch);
 
 	flags = 0;
@@ -735,19 +735,19 @@ Tcl_ScanObjCmd(
 
 	case 'd':
 	    op = 'i';
-	    parseFlag = TCL_PARSE_DECIMAL_ONLY;
+	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
 	    break;
 	case 'i':
 	    op = 'i';
-	    parseFlag = TCL_PARSE_SCAN_PREFIXES;
+	    parseFlag |= TCL_PARSE_SCAN_PREFIXES;
 	    break;
 	case 'o':
 	    op = 'i';
-	    parseFlag = TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
+	    parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
 	    break;
 	case 'x':
 	    op = 'i';
-	    parseFlag = TCL_PARSE_HEXADECIMAL_ONLY;
+	    parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
 	    break;
 	case 'u':
 	    op = 'i';
@@ -955,7 +955,7 @@ Tcl_ScanObjCmd(
 		width = ~0;
 	    }
 	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
-		    &end, TCL_PARSE_DECIMAL_ONLY)) {
+		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
 		Tcl_DecrRefCount(objPtr);
 		if (width < 0) {
 		    if (*end == '\0') {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 7760bee..9fe25d0 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStrToD.c,v 1.17 2005/11/14 17:43:51 dgp Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.18 2005/12/19 19:03:17 dgp Exp $
  *
  *----------------------------------------------------------------------
  */
@@ -162,7 +162,7 @@ static double		SafeLdExp(double fraction, int exponent);
  *	The argument flags is an input that controls the numeric formats
  *	recognized by the parser.  The flag bits are:
  *
- *	 - TCL_PARSE_INTEGER_ONLY:	accept only integer values; reject
+ *	- TCL_PARSE_INTEGER_ONLY:	accept only integer values; reject
  *		strings that denote floating point values (or accept only the
  *		leading portion of them that are integer values).
  *	- TCL_PARSE_SCAN_PREFIXES:	ignore the prefixes 0b and 0o that are
@@ -177,6 +177,7 @@ static double		SafeLdExp(double fraction, int exponent);
  *		TCL_PARSE_INTEGER_ONLY.
  * 	- TCL_PARSE_DECIMAL_ONLY:	parse only in the decimal format, no
  *		matter whether a 0 prefix would normally force a different base.
+ *	- TCL_PARSE_NO_WHITESPACE:	reject any leading/trailing whitespace
  *
  *	The arguments interp and expected are inputs that control error message
  * 	generation.  If interp is NULL, no error message will be generated.
@@ -204,18 +205,15 @@ static double		SafeLdExp(double fraction, int exponent);
  *	to a terminating NUL byte).
  *
  *	When the parser determines that a partial string matches a format
- *	it is looking for, the value of endPtrPtr determines what happens.
+ *	it is looking for, the value of endPtrPtr determines what happens:
  *
- *	If endPtrPtr is NULL, then the remainder of the string is scanned
- *	and if it consists entirely of trailing whitespace, then TCL_OK is
- *	returned and objPtr internals are set as above.  If any non-whitespace
- *	is encountered, TCL_ERROR is returned, with error message generation
- *	as above.
+ *	- If endPtrPtr is NULL, then TCL_ERROR is returned, with error message
+ *		generation as above.
  *
- *	When the parser detects a partial string match and endPtrPtr is
- *	non-NULL, then TCL_OK is returned and objPtr internals are set as
- *	above.  Also, a pointer to the first character following the parsed
- *	numeric string is written to *endPtrPtr.
+ *	- If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr
+ *		internals are set as above.  Also, a pointer to the first
+ *		character following the parsed numeric string is written
+ *		to *endPtrPtr.
  *
  *	In some cases where the string being scanned is the string rep of
  *	objPtr, this routine can leave objPtr in an inconsistent state
@@ -335,6 +333,9 @@ TclParseNumber(
 	     */
 
 	    if (isspace(UCHAR(c))) {
+		if (flags & TCL_PARSE_NO_WHITESPACE) {
+		    goto endgame;
+		}
 		break;
 	    } else if (c == '+') {
 		state = SIGNUM;
@@ -893,12 +894,14 @@ TclParseNumber(
 	/* Back up to the last accepting state in the lexer. */
 	p = acceptPoint;
 	len = acceptLen;
-	if (endPtrPtr == NULL) {
+	if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
 	    /* Accept trailing whitespace */
 	    while (len != 0 && isspace(UCHAR(*p))) {
 		++p;
 		--len;
 	    }
+	}
+	if (endPtrPtr == NULL) {
 	    if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
 		status = TCL_ERROR;
 	    }
diff --git a/tests/scan.test b/tests/scan.test
index 97c6d04..5bc986c 100644
--- a/tests/scan.test
+++ b/tests/scan.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: scan.test,v 1.18 2005/10/08 14:42:54 dgp Exp $
+# RCS: @(#) $Id: scan.test,v 1.19 2005/12/19 19:03:17 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -606,6 +606,12 @@ test scan-10.5 {miscellaneous tests} {
     set arr(2) {}
     list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2)
 } {0 1 14}
+test scan-10.6 {miscellaneous tests} {
+    scan 5a {%i%[a]}
+} {5 a}
+test scan-10.7 {miscellaneous tests} {
+    scan {5 a} {%i%[a]}
+} {5 {}}
 
 test scan-11.1 {alignment in results array (TCL_ALIGN)} {
     scan "123 13.6" "%s %f" a b
@@ -758,4 +764,4 @@ return
 
 # Local Variables:
 # mode: tcl
-# End:
\ No newline at end of file
+# End:
diff --git a/tests/string.test b/tests/string.test
index cc43191..a461a5e 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -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: string.test,v 1.54 2005/11/09 20:24:11 dgp Exp $
+# RCS: @(#) $Id: string.test,v 1.55 2005/12/19 19:03:17 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -661,6 +661,14 @@ test string-6.107 {string is integer, bad integers} {
     }
     set result
 } {1 1 0 0 0 1 0 0}
+test string-6.108 {string is double, Bug 1382287} {
+    set x 2turtledoves
+    string is double $x
+    string is double $x
+} 0
+test string-6.109 {string is double, Bug 1360532} {
+    string is double 1\u00a0
+} 0
 
 catch {rename largest_int {}}