* 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.

4 files changed, 36 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index c48934e..93dc275 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..30c5adb 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.17.2.1 2003/04/11 20:49:53 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 8e179ce..8c4a951 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.82.2.2 2003/04/07 16:54:11 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.3 2003/04/11 20:49:53 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..f1ba56d 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.36.2.1 2003/04/11 20:49:54 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 {}}