From 393936e2b829ec47b742c3225bb29250a8e728b8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 22 May 2022 17:11:58 +0000 Subject: Proposed fix for [76ad7aeba3]: boundary case bug in [string is integer]. Missing: more unit-tests --- generic/tclCmdMZ.c | 21 ++++++++++++++------- generic/tclObj.c | 18 +++++++++++++----- tests/get.test | 30 ++++++++++++++---------------- 3 files changed, 41 insertions(+), 28 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index c94abbd..8d3eda9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1451,7 +1451,6 @@ StringIsCmd( int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ int i, failat = 0, result = 1, strict = 0, index, length1, length2; Tcl_Obj *objPtr, *failVarObj = NULL; - Tcl_WideInt w; static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", @@ -1590,9 +1589,13 @@ 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) + && (type == TCL_NUMBER_LONG) && (*(long *)p <= INT_MAX) && (*(long *)p >= INT_MIN)) { + break; + } } goto failedIntParse; case STR_IS_ENTIER: @@ -1640,9 +1643,13 @@ StringIsCmd( failat = 0; } break; - case STR_IS_WIDE: - if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { - break; + case STR_IS_WIDE: { + void *p; + int type; + if (TCL_OK == TclGetNumberFromObj(NULL, objPtr, &p, &type) + && (type == TCL_NUMBER_WIDE)) { + break; + } } failedIntParse: 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} -- cgit v0.12 From f544dd76f2e5c1b1b878c3d683f16f8aab7b6f9e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 25 May 2022 10:26:59 +0000 Subject: Add testcases and fix implementation --- generic/tclCmdMZ.c | 25 +++++++++++++++---------- tests/string.test | 6 ++++++ 2 files changed, 21 insertions(+), 10 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 8d3eda9..d57dc69 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1451,6 +1451,7 @@ StringIsCmd( int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ int i, failat = 0, result = 1, strict = 0, index, length1, length2; Tcl_Obj *objPtr, *failVarObj = NULL; + Tcl_WideInt w; static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", @@ -1592,9 +1593,17 @@ StringIsCmd( case STR_IS_INT: { void *p; int type; - if (TCL_OK == TclGetNumberFromObj(NULL, objPtr, &p, &type) - && (type == TCL_NUMBER_LONG) && (*(long *)p <= INT_MAX) && (*(long *)p >= INT_MIN)) { - break; + 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; @@ -1643,13 +1652,9 @@ StringIsCmd( failat = 0; } break; - case STR_IS_WIDE: { - void *p; - int type; - if (TCL_OK == TclGetNumberFromObj(NULL, objPtr, &p, &type) - && (type == TCL_NUMBER_WIDE)) { - break; - } + case STR_IS_WIDE: + if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { + break; } failedIntParse: 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 {}} -- cgit v0.12