summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclGet.c28
-rw-r--r--generic/tclObj.c24
-rw-r--r--generic/tclUtil.c11
-rw-r--r--tests/get.test20
-rw-r--r--tests/string.test20
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} {