summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-04-11 20:50:45 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-04-11 20:50:45 (GMT)
commit1e3d8de94601b1efb0a694e0f756a0beeeded462 (patch)
tree262c9158ed0ab2883ffc3d0c5a9cbc70da00545c
parent092f06de8fa11aaa44b5d6d0a127ca0d0f87703d (diff)
downloadtcl-1e3d8de94601b1efb0a694e0f756a0beeeded462.zip
tcl-1e3d8de94601b1efb0a694e0f756a0beeeded462.tar.gz
tcl-1e3d8de94601b1efb0a694e0f756a0beeeded462.tar.bz2
* generic/tclCmdMZ.c (Tcl_StringObjCmd,STR_IS_INT): Corrected
inconsistent results of [string is integer] observed on systems where sizeof(long) != sizeof(int). [Bug 718878] * tests/string.test: Added tests for Bug 718878. * doc/string.n: Clarified that [string is integer] accepts 32-bit integers.
-rw-r--r--ChangeLog9
-rw-r--r--doc/string.n4
-rw-r--r--generic/tclCmdMZ.c18
-rw-r--r--tests/string.test18
4 files changed, 36 insertions, 13 deletions
diff --git a/ChangeLog b/ChangeLog
index 6f5f8aa..d77af36 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2003-04-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd,STR_IS_INT): Corrected
+ inconsistent results of [string is integer] observed on systems
+ where sizeof(long) != sizeof(int). [Bug 718878]
+ * tests/string.test: Added tests for Bug 718878.
+ * doc/string.n: Clarified that [string is integer] accepts
+ 32-bit integers.
+
2003-04-11 Andreas Kupries <andreask@activestate.com>
* generic/tclIO.c (UpdateInterest): When dropping interest in
diff --git a/doc/string.n b/doc/string.n
index c09c312..c5e09f1 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -5,7 +5,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.n,v 1.17 2002/07/05 07:23:45 hobbs Exp $
+'\" RCS: @(#) $Id: string.n,v 1.18 2003/04/11 20:50:47 dgp Exp $
'\"
.so man.macros
.TH string n 8.1 Tcl "Tcl Built-In Commands"
@@ -119,7 +119,7 @@ false.
.IP \fBgraph\fR 10
Any Unicode printing character, except space.
.IP \fBinteger\fR 10
-Any of the valid forms for an integer in Tcl, with optional
+Any of the valid forms for a 32-bit integer in Tcl, with optional
surrounding whitespace. In case of under/overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
.IP \fBlower\fR 10
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 508cfa0..21b439c 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.85 2003/04/11 15:59:52 vincentdarley Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.86 2003/04/11 20:50:47 dgp Exp $
*/
#include "tclInt.h"
@@ -1659,23 +1659,20 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
break;
case STR_IS_INT: {
char *stop;
+ long int l = 0;
- if ((objPtr->typePtr == &tclIntType) ||
- (Tcl_GetInt(NULL, string1, &i) == TCL_OK)) {
+ if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i)) {
break;
}
/*
* Like STR_IS_DOUBLE, but we use strtoul.
- * Since Tcl_GetInt already failed, we set result to 0.
+ * Since Tcl_GetIntFromObj already failed,
+ * we set result to 0.
*/
result = 0;
errno = 0;
-#ifdef TCL_WIDE_INT_IS_LONG
- strtoul(string1, &stop, 0); /* INTL: Tcl source. */
-#else
- strtoull(string1, &stop, 0); /* INTL: Tcl source. */
-#endif
- if (errno == ERANGE) {
+ l = strtol(string1, &stop, 0); /* INTL: Tcl source. */
+ if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) {
/*
* if (errno == ERANGE), then it was an over/underflow
* problem, but in this method, we only want to know
@@ -1683,6 +1680,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
* the failVarObj to the string length.
*/
failat = -1;
+
} else if (stop == string1) {
/*
* In this case, nothing like a number was found
diff --git a/tests/string.test b/tests/string.test
index ae84010..89ece02 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.36 2003/02/18 02:25:45 hobbs Exp $
+# RCS: @(#) $Id: string.test,v 1.37 2003/04/11 20:50:47 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -591,6 +591,22 @@ test string-6.91 {string is double, bad doubles} {
}
set result
} {1 1 0 0 0 1 0 0}
+test string-6.92 {string is double, 32-bit overflow} {
+ # Bug 718878
+ set x 0x100000000
+ list [string is integer -failindex var $x] $var
+} {0 -1}
+test string-6.93 {string is double, 32-bit overflow} {
+ # Bug 718878
+ set x 0x100000000
+ append x ""
+ list [string is integer -failindex var $x] $var
+} {0 -1}
+test string-6.94 {string is double, 32-bit overflow} {
+ # Bug 718878
+ set x 0x100000000
+ list [string is integer -failindex var [expr {$x}]] $var
+} {0 -1}
catch {rename largest_int {}}