? generic/hobbs
Index: generic/tclGet.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclGet.c,v
retrieving revision 1.7
diff -u -r1.7 tclGet.c
--- generic/tclGet.c	25 Sep 2001 16:23:56 -0000	1.7
+++ generic/tclGet.c	14 Nov 2002 19:36:16 -0000
@@ -46,7 +46,7 @@
     int *intPtr;		/* Place to store converted result. */
 {
     char *end;
-    CONST char *p;
+    CONST char *p = string;
     long i;
 
     /*
@@ -56,7 +56,14 @@
      */
 
     errno = 0;
-    for (p = string; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
+#ifdef TCL_STRTOUL_SIGN_CHECK
+    /*
+     * This special sign check actually causes bad numbers to be allowed
+     * when strtoul.  I can't find a strtoul that doesn't validly handle
+     * signed characters, and the C standard implies that this is all
+     * unnecessary. [Bug #634856]
+     */
+    for ( ; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
 	/* Empty loop body. */
     }
     if (*p == '-') {
@@ -65,9 +72,10 @@
     } else if (*p == '+') {
 	p++;
 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-    } else {
+    } else
+#else
 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-    }
+#endif
     if (end == p) {
 	badInteger:
         if (interp != (Tcl_Interp *) NULL) {
@@ -135,7 +143,7 @@
     long *longPtr;		/* Place to store converted long result. */
 {
     char *end;
-    CONST char *p;
+    CONST char *p = string;
     long i;
 
     /*
@@ -144,7 +152,8 @@
      */
 
     errno = 0;
-    for (p = string; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
+#ifdef TCL_STRTOUL_SIGN_CHECK
+    for ( ; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
 	/* Empty loop body. */
     }
     if (*p == '-') {
@@ -153,9 +162,10 @@
     } else if (*p == '+') {
 	p++;
 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-    } else {
+    } else
+#else
 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-    }
+#endif
     if (end == p) {
 	badInteger:
         if (interp != (Tcl_Interp *) NULL) {
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.40
diff -u -r1.40 tclObj.c
--- generic/tclObj.c	24 Aug 2002 01:29:46 -0000	1.40
+++ generic/tclObj.c	14 Nov 2002 19:36:16 -0000
@@ -1794,7 +1794,7 @@
      * Get the string representation. Make it up-to-date if necessary.
      */
 
-    string = Tcl_GetStringFromObj(objPtr, &length);
+    p = string = Tcl_GetStringFromObj(objPtr, &length);
 
     /*
      * Now parse "objPtr"s string as an int. We use an implementation here
@@ -1805,7 +1805,8 @@
      */
 
     errno = 0;
-    for (p = string;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
+#ifdef TCL_STRTOUL_SIGN_CHECK
+    for ( ;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
 	/* Empty loop body. */
     }
     if (*p == '-') {
@@ -1814,9 +1815,10 @@
     } else if (*p == '+') {
 	p++;
 	newLong = strtoul(p, &end, 0);
-    } else {
+    } else
+#else
 	newLong = strtoul(p, &end, 0);
-    }
+#endif
     if (end == p) {
 	badInteger:
 	if (interp != NULL) {
@@ -1865,7 +1867,7 @@
     if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
 	oldTypePtr->freeIntRepProc(objPtr);
     }
-    
+
     objPtr->internalRep.longValue = newLong;
     objPtr->typePtr = &tclIntType;
     return TCL_OK;
@@ -2147,7 +2149,7 @@
      * Get the string representation. Make it up-to-date if necessary.
      */
 
-    string = Tcl_GetStringFromObj(objPtr, &length);
+    p = string = Tcl_GetStringFromObj(objPtr, &length);
 
     /*
      * Now parse "objPtr"s string as an int. We use an implementation here
@@ -2158,7 +2160,8 @@
      */
 
     errno = 0;
-    for (p = string;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
+#ifdef TCL_STRTOUL_SIGN_CHECK
+    for ( ;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
 	/* Empty loop body. */
     }
     if (*p == '-') {
@@ -2167,9 +2170,10 @@
     } else if (*p == '+') {
 	p++;
 	newWide = strtoull(p, &end, 0);
-    } else {
+    } else
+#else
 	newWide = strtoull(p, &end, 0);
-    }
+#endif
     if (end == p) {
 	badInteger:
 	if (interp != NULL) {
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.35
diff -u -r1.35 tclUtil.c
--- generic/tclUtil.c	12 Nov 2002 02:26:40 -0000	1.35
+++ generic/tclUtil.c	14 Nov 2002 19:36:16 -0000
@@ -2406,14 +2406,15 @@
 
     if (length <= 3) {
 	offset = 0;
-    } else if (bytes[3] == '-') {
+    } else if ((length > 4) && (bytes[3] == '-')) {
 	/*
-	 * This is our limited string expression evaluator
+	 * This is our limited string expression evaluator.  Pass everything
+	 * after "end-" to Tcl_GetInt, then reverse for offset.
 	 */
-	if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {
+	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-
+	offset = -offset;
     } else {
 	/*
 	 * Conversion failed.  Report the error.
Index: tests/get.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/get.test,v
retrieving revision 1.7
diff -u -r1.7 get.test
--- tests/get.test	15 Feb 2002 23:42:12 -0000	1.7
+++ tests/get.test	14 Nov 2002 19:36:16 -0000
@@ -94,6 +94,24 @@
     list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode
 } {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}}
 
+test get-3.1 {Tcl_GetInt(FromObj), bad numbers} {
+    # SF bug #634856
+    set result ""
+    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1" "+12345678987654321" "++12345678987654321"]
+    foreach num $numbers {
+	lappend result [catch {format %ld $num} msg] $msg
+    }
+    set result
+} {0 1 0 1 1 {expected integer but got "++1"} 1 {expected integer but got "+-1"} 1 {expected integer but got "-+1"} 0 -1 1 {expected integer but got "--1"} 1 {expected integer but got "- +1"} 0 12345678987654321 1 {expected integer but got "++12345678987654321"}}
+test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} {
+    set result ""
+    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
+    foreach num $numbers {
+	lappend result [catch {format %g $num} msg] $msg
+    }
+    set result
+} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
+
 # cleanup
 ::tcltest::cleanupTests
 return
Index: tests/string.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/string.test,v
retrieving revision 1.34
diff -u -r1.34 string.test
--- tests/string.test	29 May 2002 09:09:00 -0000	1.34
+++ tests/string.test	14 Nov 2002 19:36:16 -0000
@@ -574,6 +574,24 @@
     list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
 } {0 22}
 
+test string-6.90 {string is integer, bad integers} {
+    # SF bug #634856
+    set result ""
+    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
+    foreach num $numbers {
+	lappend result [string is int -strict $num]
+    }
+    set result
+} {1 1 0 0 0 1 0 0}
+test string-6.91 {string is double, bad doubles} {
+    set result ""
+    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
+    foreach num $numbers {
+	lappend result [string is double -strict $num]
+    }
+    set result
+} {1 1 0 0 0 1 0 0}
+
 catch {rename largest_int {}}
 
 test string-7.1 {string last, too few args} {
