Fix [76ad7aeba3]: boundary case bug in [string is integer]

4 files changed, 48 insertions, 24 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index c94abbd..d57dc69 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1590,9 +1590,21 @@ StringIsCmd(
     case STR_IS_GRAPH:
 	chcomp = Tcl_UniCharIsGraph;
 	break;
-    case STR_IS_INT:
-	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
-	    break;
+    case STR_IS_INT: {
+	    void *p;
+	    int type;
+	    if (TCL_OK == TclGetNumberFromObj(NULL, objPtr, &p, &type)) {
+		if (type == TCL_NUMBER_LONG
+#ifndef TCL_WIDE_INT_IS_LONG
+			|| type == TCL_NUMBER_WIDE
+#endif
+			|| type == TCL_NUMBER_BIG) {
+		    /* [string is integer] is -UINT_MAX to UINT_MAX range */
+		    if (TclGetIntFromObj(NULL, objPtr, &i) == TCL_OK) {
+	    	break;
+		    }
+		}
+	    }
 	}
 	goto failedIntParse;
     case STR_IS_ENTIER:
diff --git a/generic/tclObj.c b/generic/tclObj.c
index b2fd80b..531a256 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2500,21 +2500,29 @@ Tcl_GetIntFromObj(
 #if (LONG_MAX == INT_MAX)
     return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
 #else
-    long l;
+    void *p;
+    int type;
 
-    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
+    if ((TclGetNumberFromObj(NULL, objPtr, &p, &type) != TCL_OK)
+	    || (type == TCL_NUMBER_DOUBLE)) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "expected integer but got \"%s\"", Tcl_GetString(objPtr)));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+	}
 	return TCL_ERROR;
     }
-    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
+    if ((type != TCL_NUMBER_LONG) || ((ULONG_MAX > UINT_MAX)
+	    && ((*(long *)p > UINT_MAX) || (*(long *)p < -(long)UINT_MAX)))) {
 	if (interp != NULL) {
 	    const char *s =
-		    "integer value too large to represent as non-long integer";
+		    "integer value too large to represent";
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
 	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
 	}
 	return TCL_ERROR;
     }
-    *intPtr = (int) l;
+    *intPtr = (int)*(long *)p;
     return TCL_OK;
 #endif
 }
diff --git a/tests/get.test b/tests/get.test
index b9a83ac..a7bab5d 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -20,8 +20,6 @@ catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testgetint [llength [info commands testgetint]]
 testConstraint testdoubleobj [llength [info commands testdoubleobj]]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
 
 test get-1.1 {Tcl_GetInt procedure} testgetint {
     testgetint 44 { 	  22}
@@ -41,28 +39,28 @@ test get-1.5 {Tcl_GetInt procedure} testgetint {
 test get-1.6 {Tcl_GetInt procedure} testgetint {
     list [catch {testgetint 44 {16	 x}} msg] $msg
 } {1 {expected integer but got "16	 x"}}
-test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
+test get-1.7 {Tcl_GetInt procedure} testgetint {
     list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode
 } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} {
-    list [catch {testgetint 18446744073709551614} msg] $msg
-} {0 -2}
-test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
-    list [catch {testgetint +18446744073709551614} msg] $msg
-} {0 -2}
-test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
-    list [catch {testgetint -18446744073709551614} msg] $msg
-} {0 2}
-test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
+test get-1.8 {Tcl_GetInt procedure} testgetint {
+    list [catch {testgetint 18446744073709551614} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+test get-1.9 {Tcl_GetInt procedure} testgetint {
+    list [catch {testgetint +18446744073709551614} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+test get-1.10 {Tcl_GetInt procedure} testgetint {
+    list [catch {testgetint -18446744073709551614} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+test get-1.11 {Tcl_GetInt procedure} testgetint {
     list [catch {testgetint 44 4294967296} msg] $msg $errorCode
 } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} {
+test get-1.12 {Tcl_GetInt procedure} testgetint {
     list [catch {testgetint 4294967294} msg] $msg
 } {0 -2}
-test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
+test get-1.13 {Tcl_GetInt procedure} testgetint {
     list [catch {testgetint +4294967294} msg] $msg
 } {0 -2}
-test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
+test get-1.14 {Tcl_GetInt procedure} testgetint {
     list [catch {testgetint -4294967294} msg] $msg
 } {0 2}
 
diff --git a/tests/string.test b/tests/string.test
index 172b22d..ad6b126 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -795,6 +795,12 @@ test string-6.130.1.$noComp {string is entier, false on bad octal} {
 test string-6.131.$noComp {string is entier, false on bad hex} {
     list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
 } {0 88}
+test string-6.132.$noComp {string is integer, bug [76ad7aeba3]} {
+    run {string is integer 18446744073709551615}
+} 0
+test string-6.133.$noComp {string is integer, bug [76ad7aeba3]} {
+    run {string is integer -18446744073709551615}
+} 0
 
 catch {rename largest_int {}}