* generic/tclUtil.c (SetEndOffsetFromAny): handle integer offset

	after the "end-" prefix.

	* generic/get.test:
	* generic/string.test:
	* generic/tclObj.c (SetIntFromAny, SetWideIntFromAny):
	* generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign
	handling before calling strtoul(l). [Bug #634856]

6 files changed, 88 insertions, 26 deletions

diff --git a/ChangeLog b/ChangeLog
index 018bd46..36d95d7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2002-11-18  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* generic/tclUtil.c (SetEndOffsetFromAny): handle integer offset
+	after the "end-" prefix.
+
+	* generic/get.test:
+	* generic/string.test:
+	* generic/tclObj.c (SetIntFromAny, SetWideIntFromAny): 
+	* generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign
+	handling before calling strtoul(l). [Bug #634856]
+
 2002-11-18  David Gravereaux  <davygrvy@pobox.com>
 
 	* win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed
diff --git a/generic/tclGet.c b/generic/tclGet.c
index a42a3f1..6819322 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.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: tclGet.c,v 1.7 2001/09/25 16:23:56 dgp Exp $
+ * RCS: @(#) $Id: tclGet.c,v 1.8 2002/11/19 02:34:49 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -46,7 +46,7 @@ Tcl_GetInt(interp, string, intPtr)
     int *intPtr;		/* Place to store converted result. */
 {
     char *end;
-    CONST char *p;
+    CONST char *p = string;
     long i;
 
     /*
@@ -56,7 +56,14 @@ Tcl_GetInt(interp, string, intPtr)
      */
 
     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 @@ Tcl_GetInt(interp, string, intPtr)
     } 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 @@ TclGetLong(interp, string, longPtr)
     long *longPtr;		/* Place to store converted long result. */
 {
     char *end;
-    CONST char *p;
+    CONST char *p = string;
     long i;
 
     /*
@@ -144,7 +152,8 @@ TclGetLong(interp, string, longPtr)
      */
 
     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 @@ TclGetLong(interp, string, longPtr)
     } 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) {
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 2e4dc5e..8200cf3 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.40 2002/08/24 01:29:46 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.41 2002/11/19 02:34:50 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1794,7 +1794,7 @@ SetIntFromAny(interp, objPtr)
      * 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 @@ SetIntFromAny(interp, objPtr)
      */
 
     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 @@ SetIntFromAny(interp, objPtr)
     } 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 @@ SetIntFromAny(interp, objPtr)
     if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
 	oldTypePtr->freeIntRepProc(objPtr);
     }
-    
+
     objPtr->internalRep.longValue = newLong;
     objPtr->typePtr = &tclIntType;
     return TCL_OK;
@@ -2147,7 +2149,7 @@ SetWideIntFromAny(interp, objPtr)
      * 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 @@ SetWideIntFromAny(interp, objPtr)
      */
 
     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 @@ SetWideIntFromAny(interp, objPtr)
     } 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) {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 2d6ba05..a4d783b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.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: tclUtil.c,v 1.35 2002/11/12 02:26:40 hobbs Exp $
+ *  RCS: @(#) $Id: tclUtil.c,v 1.36 2002/11/19 02:34:50 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -2406,14 +2406,15 @@ SetEndOffsetFromAny(interp, objPtr)
 
     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.
diff --git a/tests/get.test b/tests/get.test
index 0d9bea8..4c3f679 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: get.test,v 1.7 2002/02/15 23:42:12 kennykb Exp $
+# RCS: @(#) $Id: get.test,v 1.8 2002/11/19 02:34:50 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -94,6 +94,24 @@ test get-2.4 {Tcl_GetInt procedure} {nonPortable} {
     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
diff --git a/tests/string.test b/tests/string.test
index d2bdb6d..bffb623 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.34 2002/05/29 09:09:00 hobbs Exp $
+# RCS: @(#) $Id: string.test,v 1.35 2002/11/19 02:34:50 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -574,6 +574,24 @@ test string-6.89 {string is xdigit} {
     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} {