diff options
| -rw-r--r-- | generic/tclBasic.c | 60 | ||||
| -rw-r--r-- | generic/tclBinary.c | 35 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 2 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 2 | ||||
| -rw-r--r-- | generic/tclInt.h | 2 | ||||
| -rw-r--r-- | generic/tclObj.c | 68 | ||||
| -rw-r--r-- | generic/tclScan.c | 24 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 91 | ||||
| -rw-r--r-- | tests/compExpr-old.test | 6 | ||||
| -rw-r--r-- | tests/expr-old.test | 4 | ||||
| -rw-r--r-- | tests/expr.test | 6 | ||||
| -rw-r--r-- | tests/format.test | 9 | ||||
| -rw-r--r-- | tests/get.test | 4 | ||||
| -rw-r--r-- | tests/obj.test | 17 | ||||
| -rw-r--r-- | tests/scan.test | 15 | ||||
| -rw-r--r-- | tests/string.test | 24 |
16 files changed, 238 insertions, 131 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0769f24..b31d5bd 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -114,7 +114,6 @@ static Tcl_ObjCmdProc ExprBinaryFunc; static Tcl_ObjCmdProc ExprBoolFunc; static Tcl_ObjCmdProc ExprCeilFunc; static Tcl_ObjCmdProc ExprDoubleFunc; -static Tcl_ObjCmdProc ExprEntierFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; @@ -125,6 +124,7 @@ static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; +static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -315,7 +315,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "cos", ExprUnaryFunc, (ClientData) cos }, { "cosh", ExprUnaryFunc, (ClientData) cosh }, { "double", ExprDoubleFunc, NULL }, - { "entier", ExprEntierFunc, NULL }, + { "entier", ExprIntFunc, NULL }, { "exp", ExprUnaryFunc, (ClientData) exp }, { "floor", ExprFloorFunc, NULL }, { "fmod", ExprBinaryFunc, (ClientData) fmod }, @@ -335,7 +335,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "srand", ExprSrandFunc, NULL }, { "tan", ExprUnaryFunc, (ClientData) tan }, { "tanh", ExprUnaryFunc, (ClientData) tanh }, - { "wide", ExprIntFunc, NULL }, + { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } }; @@ -3659,12 +3659,20 @@ OldMathFuncProc( args[k].doubleValue = d; break; case TCL_INT: - case TCL_WIDE_INT: if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { ckfree(args); return TCL_ERROR; } valuePtr = Tcl_GetObjResult(interp); + Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); + Tcl_ResetResult(interp); + break; + case TCL_WIDE_INT: + if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { + ckfree(args); + return TCL_ERROR; + } + valuePtr = Tcl_GetObjResult(interp); TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); Tcl_ResetResult(interp); break; @@ -7608,7 +7616,7 @@ ExprDoubleFunc( } static int -ExprEntierFunc( +ExprIntFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ @@ -7664,7 +7672,7 @@ ExprEntierFunc( } static int -ExprIntFunc( +ExprWideFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ @@ -7672,26 +7680,11 @@ ExprIntFunc( Tcl_Obj *const *objv) /* Actual parameter vector. */ { Tcl_WideInt wResult; - Tcl_Obj *objPtr; - if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) { + if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) { return TCL_ERROR; } - objPtr = Tcl_GetObjResult(interp); - if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) { - /* - * Truncate the bignum; keep only bits in wide int range. - */ - - mp_int big; - - Tcl_GetBignumFromObj(NULL, objPtr, &big); - mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big); - objPtr = Tcl_NewBignumObj(&big); - Tcl_IncrRefCount(objPtr); - TclGetWideIntFromObj(NULL, objPtr, &wResult); - Tcl_DecrRefCount(objPtr); - } + TclGetLeastSign64bits(NULL, Tcl_GetObjResult(interp), &wResult); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult)); return TCL_OK; } @@ -7938,7 +7931,7 @@ ExprSrandFunc( Tcl_Obj *const *objv) /* Parameter vector. */ { Interp *iPtr = (Interp *) interp; - long i = 0; /* Initialized to avoid compiler warning. */ + Tcl_WideInt w = 0; /* Initialized to avoid compiler warning. */ /* * Convert argument and use it to reset the seed. @@ -7949,20 +7942,8 @@ ExprSrandFunc( return TCL_ERROR; } - if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) { - Tcl_Obj *objPtr; - mp_int big; - - if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { - /* TODO: more ::errorInfo here? or in caller? */ - return TCL_ERROR; - } - - mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); - objPtr = Tcl_NewBignumObj(&big); - Tcl_IncrRefCount(objPtr); - TclGetLongFromObj(NULL, objPtr, &i); - Tcl_DecrRefCount(objPtr); + if (TclGetLeastSign64bits(NULL, objv[1], &w) != TCL_OK) { + return TCL_ERROR; } /* @@ -7971,8 +7952,7 @@ ExprSrandFunc( */ iPtr->flags |= RAND_SEED_INITIALIZED; - iPtr->randSeed = i; - iPtr->randSeed &= (unsigned long) 0x7fffffff; + iPtr->randSeed = w & (unsigned long) 0x7fffffff; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { iPtr->randSeed ^= 123459876; } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index cb5a5cb..c91611c 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -1963,7 +1963,6 @@ FormatNumber( Tcl_Obj *src, /* Number to format. */ unsigned char **cursorPtr) /* Pointer to index into destination buffer. */ { - long value; double dvalue; Tcl_WideInt wvalue; float fvalue; @@ -2025,7 +2024,7 @@ FormatNumber( case 'w': case 'W': case 'm': - if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) { + if (TclGetLeastSign64bits(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { @@ -2055,19 +2054,19 @@ FormatNumber( case 'i': case 'I': case 'n': - if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { + if (TclGetLeastSign64bits(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { - *(*cursorPtr)++ = UCHAR(value); - *(*cursorPtr)++ = UCHAR(value >> 8); - *(*cursorPtr)++ = UCHAR(value >> 16); - *(*cursorPtr)++ = UCHAR(value >> 24); + *(*cursorPtr)++ = UCHAR(wvalue); + *(*cursorPtr)++ = UCHAR(wvalue >> 8); + *(*cursorPtr)++ = UCHAR(wvalue >> 16); + *(*cursorPtr)++ = UCHAR(wvalue >> 24); } else { - *(*cursorPtr)++ = UCHAR(value >> 24); - *(*cursorPtr)++ = UCHAR(value >> 16); - *(*cursorPtr)++ = UCHAR(value >> 8); - *(*cursorPtr)++ = UCHAR(value); + *(*cursorPtr)++ = UCHAR(wvalue >> 24); + *(*cursorPtr)++ = UCHAR(wvalue >> 16); + *(*cursorPtr)++ = UCHAR(wvalue >> 8); + *(*cursorPtr)++ = UCHAR(wvalue); } return TCL_OK; @@ -2077,15 +2076,15 @@ FormatNumber( case 's': case 'S': case 't': - if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { + if (TclGetLeastSign64bits(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { - *(*cursorPtr)++ = UCHAR(value); - *(*cursorPtr)++ = UCHAR(value >> 8); + *(*cursorPtr)++ = UCHAR(wvalue); + *(*cursorPtr)++ = UCHAR(wvalue >> 8); } else { - *(*cursorPtr)++ = UCHAR(value >> 8); - *(*cursorPtr)++ = UCHAR(value); + *(*cursorPtr)++ = UCHAR(wvalue >> 8); + *(*cursorPtr)++ = UCHAR(wvalue); } return TCL_OK; @@ -2093,10 +2092,10 @@ FormatNumber( * 8-bit integer values. */ case 'c': - if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { + if (TclGetLeastSign64bits(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } - *(*cursorPtr)++ = UCHAR(value); + *(*cursorPtr)++ = UCHAR(wvalue); return TCL_OK; default: diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index f99a4a0..c2b0ba9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1622,6 +1622,7 @@ StringIsCmd( case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; + case STR_IS_INT: case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || (objPtr->typePtr == &tclBignumType)) { @@ -1664,7 +1665,6 @@ StringIsCmd( failat = 0; } break; - case STR_IS_INT: case STR_IS_WIDE: if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { break; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 8ab1ffa..243f8a9 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -691,11 +691,11 @@ TclCompileStringIsCmd( } switch (t) { - case STR_IS_INT: case STR_IS_WIDE: PUSH( "2"); OP( LE); break; + case STR_IS_INT: case STR_IS_ENTIER: PUSH( "3"); OP( LE); diff --git a/generic/tclInt.h b/generic/tclInt.h index 928d649..7d93d30 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3044,6 +3044,8 @@ MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp, const char *targetName, const char *packageName); +MODULE_SCOPE int TclGetLeastSign64bits(Tcl_Interp *, Tcl_Obj *, + Tcl_WideInt *); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); diff --git a/generic/tclObj.c b/generic/tclObj.c index 3bbe7b6..75f9cb7 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3123,6 +3123,74 @@ Tcl_GetWideIntFromObj( return TCL_ERROR; } + +/* + *---------------------------------------------------------------------- + * + * TclGetLeastSign64bits -- + * + * Attempt to return a wide integer from the Tcl object "objPtr". If the + * object is not already a wide int object, an attempt will be made to + * convert it to one. Integer out-of-range values don't result in an + * error, but only the least significant 64 bit will be returned. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already an int object, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +int +TclGetLeastSign64bits( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */ +{ + do { + if (objPtr->typePtr == &tclIntType) { + *wideIntPtr = objPtr->internalRep.wideValue; + return TCL_OK; + } + if (objPtr->typePtr == &tclDoubleType) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + } + return TCL_ERROR; + } + if (objPtr->typePtr == &tclBignumType) { + mp_int big; + + Tcl_WideUInt value = 0, scratch; + unsigned long numBytes = sizeof(Tcl_WideInt); + unsigned char *bytes = (unsigned char *) &scratch; + + Tcl_GetBignumFromObj(NULL, objPtr, &big); + mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big); + mp_to_unsigned_bin_n(&big, bytes, &numBytes); + while (numBytes-- > 0) { + value = (value << CHAR_BIT) | *bytes++; + } + if (big.sign) { + value = -value; + } + *wideIntPtr = (Tcl_WideInt) value; + mp_clear(&big); + return TCL_OK; + } + } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, + TCL_PARSE_INTEGER_ONLY)==TCL_OK); + return TCL_ERROR; +} + /* *---------------------------------------------------------------------- * diff --git a/generic/tclScan.c b/generic/tclScan.c index 458dbd8..cfc3a92 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -571,10 +571,11 @@ Tcl_ScanObjCmd( const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; - Tcl_WideInt value; + long value; const char *string, *end, *baseString; char op = 0; int width, underflow = 0; + Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; @@ -923,7 +924,18 @@ Tcl_ScanObjCmd( Tcl_DecrRefCount(objPtr); break; } - if (flags & SCAN_BIG) { + if (flags & SCAN_LONGER) { + if (TclGetLeastSign64bits(NULL, objPtr, &wideValue) != TCL_OK) { + goto done; + } + if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { + sprintf(buf, "%" TCL_LL_MODIFIER "u", + (Tcl_WideUInt)wideValue); + Tcl_SetStringObj(objPtr, buf, -1); + } else { + TclSetIntObj(objPtr, wideValue); + } + } else if (flags & SCAN_BIG) { if (flags & SCAN_UNSIGNED) { mp_int big; int code = Tcl_GetBignumFromObj(interp, objPtr, &big); @@ -948,15 +960,15 @@ Tcl_ScanObjCmd( } } } else { - if (TclGetWideIntFromObj(NULL, objPtr, &value) != TCL_OK) { + if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { - value = LLONG_MIN; + value = LONG_MIN; } else { - value = LLONG_MAX; + value = LONG_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%" TCL_LL_MODIFIER "u", value); /* INTL: ISO digit */ + sprintf(buf, "%lu", value); /* INTL: ISO digit */ Tcl_SetStringObj(objPtr, buf, -1); } else { TclSetIntObj(objPtr, value); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 60df2dd..f98180f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1793,6 +1793,9 @@ Tcl_AppendFormatToObj( char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; +#ifndef TCL_WIDE_INT_IS_LONG + int useWide = 0; +#endif int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -1983,11 +1986,18 @@ Tcl_AppendFormatToObj( useBig = 1; format += step; step = TclUtfToUniChar(format, &ch); +#ifndef TCL_WIDE_INT_IS_LONG + } else { + useWide = 1; +#endif } } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); +#ifndef TCL_WIDE_INT_IS_LONG + useWide = 1; +#endif } else if ((format[1] == '3') && (format[2] == '2')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); @@ -2057,10 +2067,16 @@ Tcl_AppendFormatToObj( case 'b': { short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ + long l; Tcl_WideInt w; mp_int big; int toAppend, isNegative = 0; +#ifndef TCL_WIDE_INT_IS_LONG + if (ch == 'p') { + useWide = 1; + } +#endif if (useBig) { int cmpResult; if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { @@ -2079,32 +2095,53 @@ Tcl_AppendFormatToObj( ch = 'd'; } } - } else if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { - Tcl_Obj *objPtr; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (useWide) { + if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { + Tcl_Obj *objPtr; - if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { - goto error; + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { + goto error; + } + mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big); + objPtr = Tcl_NewBignumObj(&big); + Tcl_IncrRefCount(objPtr); + TclGetWideIntFromObj(NULL, objPtr, &w); + Tcl_DecrRefCount(objPtr); + } + isNegative = (w < (Tcl_WideInt) 0); + if (w == (Tcl_WideInt) 0) gotHash = 0; +#endif + } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { + Tcl_Obj *objPtr; + + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { + goto error; + } + mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); + objPtr = Tcl_NewBignumObj(&big); + Tcl_IncrRefCount(objPtr); + TclGetLongFromObj(NULL, objPtr, &l); + Tcl_DecrRefCount(objPtr); + } else { + l = Tcl_WideAsLong(w); } - mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); - objPtr = Tcl_NewBignumObj(&big); - Tcl_IncrRefCount(objPtr); - TclGetWideIntFromObj(NULL, objPtr, &w); - Tcl_DecrRefCount(objPtr); if (useShort) { - s = (short) w; + s = (short) l; isNegative = (s < (short) 0); if (s == (short) 0) gotHash = 0; } else { - isNegative = (w < (long) 0); - if (w == (long) 0) gotHash = 0; + isNegative = (l < (long) 0); + if (l == (long) 0) gotHash = 0; } } else if (useShort) { - s = (short) w; + s = (short) l; isNegative = (s < (short) 0); if (s == (short) 0) gotHash = 0; } else { - isNegative = (w < (Tcl_WideInt) 0); - if (w == (Tcl_WideInt) 0) gotHash = 0; + isNegative = (l < (long) 0); + if (l == (long) 0) gotHash = 0; } segment = Tcl_NewObj(); @@ -2153,10 +2190,14 @@ Tcl_AppendFormatToObj( if (useShort) { pure = Tcl_NewIntObj((int) s); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (useWide) { + pure = Tcl_NewWideIntObj(w); +#endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { - pure = Tcl_NewWideIntObj(w); + pure = Tcl_NewLongObj(l); } Tcl_IncrRefCount(pure); bytes = TclGetStringFromObj(pure, &length); @@ -2236,6 +2277,16 @@ Tcl_AppendFormatToObj( numDigits++; us /= base; } +#ifndef TCL_WIDE_INT_IS_LONG + } else if (useWide) { + Tcl_WideUInt uw = (Tcl_WideUInt) w; + + bits = uw; + while (uw) { + numDigits++; + uw /= base; + } +#endif } else if (useBig && big.used) { int leftover = (big.used * DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); @@ -2252,12 +2303,12 @@ Tcl_AppendFormatToObj( goto errorMsg; } } else if (!useBig) { - Tcl_WideUInt uw = (Tcl_WideUInt) w; + unsigned long ul = (unsigned long) l; - bits = (Tcl_WideUInt) uw; - while (uw) { + bits = (Tcl_WideUInt) ul; + while (ul) { numDigits++; - uw /= base; + ul /= base; } } diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 0136ccd..9dfe4c4 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -78,8 +78,8 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] # procedures used below @@ -337,7 +337,7 @@ test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { expr {int(1<<63)} -} -9223372036854775808 +} 9223372036854775808 test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { expr {int(1<<31)} } -2147483648 diff --git a/tests/expr-old.test b/tests/expr-old.test index a73b77a..7f89d99 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -813,10 +813,10 @@ test expr-old-32.32 {math functions in expressions} { } {-1} test expr-old-32.33 {math functions in expressions} { expr int(1e60) -} 0 +} 999999999999999949387135297074018866963645011013410073083904 test expr-old-32.34 {math functions in expressions} { expr int(-1e60) -} 0 +} -999999999999999949387135297074018866963645011013410073083904 test expr-old-32.35 {math functions in expressions} { expr round(1.49) } {1} diff --git a/tests/expr.test b/tests/expr.test index 713681a..913df1b 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -21,8 +21,8 @@ catch [list package require -exact Tcltest [info patchlevel]] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] testConstraint wideIs64bit \ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] @@ -419,7 +419,7 @@ test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1 test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { expr {int(1<<63)} -} -9223372036854775808 +} 9223372036854775808 test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { expr {int(1<<31)} } -2147483648 diff --git a/tests/format.test b/tests/format.test index cdea545..2fab1d9 100644 --- a/tests/format.test +++ b/tests/format.test @@ -16,11 +16,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } # %u output depends on word length, so this test is not portable. -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] testConstraint wideIs64bit \ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] -testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] test format-1.1 {integer formatting} { @@ -547,7 +546,7 @@ for {set i 290} {$i < 400} {incr i} { append b "x" } -test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} { +test format-17.1 {testing %d with wide} {wideIs64bit longIs32bit} { format %d 7810179016327718216 } 1819043144 test format-17.2 {testing %ld with wide} {wideIs64bit} { @@ -580,7 +579,7 @@ test format-18.1 {do not demote existing numeric values} { format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} -test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} { +test format-18.2 {do not demote existing numeric values} {longIs32bit} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] diff --git a/tests/get.test b/tests/get.test index b02b686..f85bc01 100644 --- a/tests/get.test +++ b/tests/get.test @@ -20,8 +20,8 @@ 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}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] test get-1.1 {Tcl_GetInt procedure} testgetint { testgetint 44 { 22} diff --git a/tests/obj.test b/tests/obj.test index ffd1a59..616564a 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -21,7 +21,6 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 @@ -549,34 +548,34 @@ test obj-32.1 {freeing very large object trees} { unset x } {} -test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.1 {integer overflow on input} {longIs32bit} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} -test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.2 {integer overflow on input} {longIs32bit} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} -test obj-33.3 {integer overflow on input} { +test obj-33.3 {no integer overflow on input} { set x 0x100000000; append x 00000000 list [string is integer $x] [expr { $x }] -} {0 18446744073709551616} -test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +} {1 18446744073709551616} +test obj-33.4 {integer overflow on input} {longIs32bit} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} -test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.5 {integer overflow on input} {longIs32bit} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} -test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.6 {integer overflow on input} {longIs32bit} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} test obj-33.7 {integer overflow on input} { set x -0x100000000; append x 00000000 list [string is integer $x] [expr { $x }] -} {0 -18446744073709551616} +} {1 -18446744073709551616} test obj-34.1 {mp_iseven} testobj { set result "" diff --git a/tests/scan.test b/tests/scan.test index 1f32b9f..f7f7049 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -19,11 +19,8 @@ if {"::tcltest" ni [namespace children]} { # procedure that returns the range of integers proc int_range {} { - for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} { - set MIN_INT [expr { $MIN_INT << 1 }] - } - set MIN_INT [expr {int($MIN_INT)}] - set MAX_INT [expr { ~ $MIN_INT }] + set MAX_INT [expr {[format %lu -2]/2}] + set MIN_INT [expr { ~ $MAX_INT }] return [list $MIN_INT $MAX_INT] } @@ -446,14 +443,14 @@ test scan-4.61 {Tcl_ScanObjCmd, set errors} -setup { test scan-4.62 {scanning of large and negative octal integers} { lassign [int_range] MIN_INT MAX_INT - set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT] - list [scan $scanstring {%o %o %o} a b c] \ + set scanstring [format {%lo %lo %lo} -1 $MIN_INT $MAX_INT] + list [scan $scanstring {%lo %lo %lo} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} test scan-4.63 {scanning of large and negative hex integers} { lassign [int_range] MIN_INT MAX_INT - set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT] - list [scan $scanstring {%x %x %x} a b c] \ + set scanstring [format {%lx %lx %lx} -1 $MIN_INT $MAX_INT] + list [scan $scanstring {%lx %lx %lx} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} test scan-4.64 {scanning of hex with %X} { diff --git a/tests/string.test b/tests/string.test index 81588ff..a0eaac8 100644 --- a/tests/string.test +++ b/tests/string.test @@ -674,9 +674,9 @@ test string-6.53.$noComp {string is integer, true with whitespace} { test string-6.54.$noComp {string is integer, false} { list [run {string is integer -fail var 123abc}] $var } {0 3} -test string-6.55.$noComp {string is integer, false on overflow} { - list [run {string is integer -fail var +[largest_int]0}] $var -} {0 -1} +test string-6.55.$noComp {string is integer, no overflow possible} { + run {string is integer +[largest_int]0} +} 1 test string-6.56.$noComp {string is integer, false} { list [run {string is integer -fail var [expr double(1)]}] $var } {0 1} @@ -807,22 +807,22 @@ test string-6.91.$noComp {string is double, bad doubles} { } return $result } {1 1 0 0 0 1 0 0} -test string-6.92.$noComp {string is integer, 64-bit overflow} { +test string-6.92.$noComp {string is integer, no 64-bit overflow} { # Bug 718878 set x 0x10000000000000000 - list [run {string is integer -failindex var $x}] $var -} {0 -1} -test string-6.93.$noComp {string is integer, 64-bit overflow} { + run {string is integer $x} +} 1 +test string-6.93.$noComp {string is integer, no 64-bit overflow} { # Bug 718878 set x 0x10000000000000000 append x "" - list [run {string is integer -failindex var $x}] $var -} {0 -1} -test string-6.94.$noComp {string is integer, 64-bit overflow} { + run {string is integer $x} +} 1 +test string-6.94.$noComp {string is integer, no 64-bit overflow} { # Bug 718878 set x 0x10000000000000000 - list [run {string is integer -failindex var [expr {$x}]}] $var -} {0 -1} + run {string is integer [expr {$x}]} +} 1 test string-6.95.$noComp {string is wideinteger, true} { run {string is wideinteger +1234567890} } 1 |