Attachment "string634856.patch" to
ticket [634856ffff]
added by
hobbs
2002-11-15 02:42:17.
? 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} {
