From 67e505d2abdb7ddb2d38ee7e579785a410008188 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 27 Oct 2017 08:45:13 +0000 Subject: First implementation of [http://core.tcl.tk/tips/doc/trunk/tip/481.md|TIP #481]: Extend size range of various Tcl_Get*() functions --- generic/tcl.decls | 12 ++++++++++++ generic/tcl.h | 8 ++++++++ generic/tclDecls.h | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclObj.c | 48 ++++++++++++++++++++++++++++++++++++++++++++-- generic/tclStringObj.c | 26 ++++++++++++++++++++++++- generic/tclStubInit.c | 5 +++++ generic/tclTest.c | 26 +++++++++++++------------ generic/tclTestObj.c | 5 +++-- 8 files changed, 165 insertions(+), 17 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..85b7b81 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2332,6 +2332,18 @@ declare 631 { const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData) } +# TIP #481 +declare 634 { + int Tcl_GetValue(Tcl_Interp *interp, Tcl_Obj *objPtr, + void *intPtr, int flags) +} +declare 635 { + char *Tcl_GetStringFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr) +} +declare 636 { + Tcl_UniChar *Tcl_GetUnicodeFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tcl.h b/generic/tcl.h index 07d841d..17406e1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1153,6 +1153,14 @@ typedef struct Tcl_DString { #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_READ_ONLY 0x80 + +/* + * Types for Tcl_GetValue(): + */ + +#define TCL_TYPE_I(type) (0x100 | (int)sizeof(type)) /* signed integer */ +#define TCL_TYPE_U(type) (0x200 | (int)sizeof(type)) /* unsigned integer */ +#define TCL_TYPE_D(type) (0x300 | (int)sizeof(type)) /* float/double/long double */ /* *---------------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..b4b0320 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1831,6 +1831,17 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); +/* Slot 632 is reserved */ +/* Slot 633 is reserved */ +/* 634 */ +EXTERN int Tcl_GetValue(Tcl_Interp *interp, Tcl_Obj *objPtr, + void *intPtr, int flags); +/* 635 */ +EXTERN char * Tcl_GetStringFromObj2(Tcl_Obj *objPtr, + size_t *lengthPtr); +/* 636 */ +EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj2(Tcl_Obj *objPtr, + size_t *lengthPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2498,6 +2509,11 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + void (*reserved632)(void); + void (*reserved633)(void); + int (*tcl_GetValue) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *intPtr, int flags); /* 634 */ + char * (*tcl_GetStringFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 635 */ + Tcl_UniChar * (*tcl_GetUnicodeFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 636 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3792,6 +3808,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ #define Tcl_OpenTcpServerEx \ (tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */ +/* Slot 632 is reserved */ +/* Slot 633 is reserved */ +#define Tcl_GetValue \ + (tclStubsPtr->tcl_GetValue) /* 634 */ +#define Tcl_GetStringFromObj2 \ + (tclStubsPtr->tcl_GetStringFromObj2) /* 635 */ +#define Tcl_GetUnicodeFromObj2 \ + (tclStubsPtr->tcl_GetUnicodeFromObj2) /* 636 */ #endif /* defined(USE_TCL_STUBS) */ @@ -3966,6 +3990,34 @@ extern const TclStubs *tclStubsPtr; # endif #endif +#undef Tcl_GetDoubleFromObj +#undef Tcl_GetIntFromObj +#undef Tcl_GetStringFromObj +#undef Tcl_GetUnicodeFromObj +#if defined(USE_TCL_STUBS) +#define Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) \ + (sizeof(*dblPtr) == sizeof(double) ? tclStubsPtr->tcl_GetDoubleFromObj(interp, objPtr, (double *)dblPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr))) +#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? tclStubsPtr->tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr))) +#define Tcl_GetUIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? tclStubsPtr->tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_U(*intPtr))) +#define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr)) +#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetUnicodeFromObj2(objPtr, (size_t *)sizePtr)) +#else +#define Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) \ + (sizeof(*dblPtr) == sizeof(double) ? (Tcl_GetDoubleFromObj)(interp, objPtr, (double *)dblPtr) : Tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr))) +#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? Tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : Tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr))) +#define Tcl_GetUIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? Tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : Tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_U(*intPtr))) +#define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? Tcl_GetStringFromObj(objPtr, (int *)sizePtr) : Tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr)) +#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? Tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : Tcl_GetUnicodeFromObj2(objPtr, (size_t *)sizePtr)) +#endif + /* * Deprecated Tcl procedures: */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 1a00011..f61ccb7 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1659,7 +1659,7 @@ Tcl_GetString( /* *---------------------------------------------------------------------- * - * Tcl_GetStringFromObj -- + * Tcl_GetStringFromObj/Tcl_GetStringFromObj2 -- * * Returns the string representation's byte array pointer and length for * an object. @@ -1679,6 +1679,7 @@ Tcl_GetString( *---------------------------------------------------------------------- */ +#undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should @@ -1694,6 +1695,21 @@ Tcl_GetStringFromObj( } return objPtr->bytes; } +char * +Tcl_GetStringFromObj2( + register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + * be returned. */ + register size_t *lengthPtr) /* If non-NULL, the location where the string + * rep's byte array length should * be stored. + * If NULL, no length is stored. */ +{ + (void) TclGetString(objPtr); + + if (lengthPtr != NULL) { + *lengthPtr = objPtr->length; + } + return objPtr->bytes; +} /* *---------------------------------------------------------------------- @@ -2273,6 +2289,7 @@ Tcl_SetDoubleObj( *---------------------------------------------------------------------- */ +#undef Tcl_GetDoubleFromObj int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -2466,7 +2483,7 @@ Tcl_SetIntObj( /* *---------------------------------------------------------------------- * - * Tcl_GetIntFromObj -- + * Tcl_GetIntFromObj/Tcl_GetValue -- * * Attempt to return an int from the Tcl object "objPtr". If the object * is not already an int, an attempt will be made to convert it to one. @@ -2489,6 +2506,7 @@ Tcl_SetIntObj( *---------------------------------------------------------------------- */ +#undef Tcl_GetIntFromObj int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -2516,6 +2534,32 @@ Tcl_GetIntFromObj( return TCL_OK; #endif } +int +Tcl_GetValue( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr, /* The object from which to get a int. */ + register void *ptr, /* Place to store resulting int. */ + register int flags) +{ + double value; + int result; + if (flags == TCL_TYPE_I(int)) { + return Tcl_GetIntFromObj(interp, objPtr, ptr); + } + if (flags == TCL_TYPE_I(Tcl_WideInt)) { + return Tcl_GetWideIntFromObj(interp, objPtr, ptr); + } + if (flags == TCL_TYPE_D(double)) { + return Tcl_GetDoubleFromObj(interp, objPtr, ptr); + } + result = Tcl_GetDoubleFromObj(interp, objPtr, &value); + if (flags == TCL_TYPE_D(float)) { + *(float *)ptr = (float) value; + } else { + *(long double *)ptr = (long double) value; + } + return result; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 7c1d42b..0195656 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -540,7 +540,7 @@ Tcl_GetUnicode( /* *---------------------------------------------------------------------- * - * Tcl_GetUnicodeFromObj -- + * Tcl_GetUnicodeFromObj/Tcl_GetUnicodeFromObj2 -- * * Get the Unicode form of the String object with length. If the object * is not already a String object, it will be converted to one. If the @@ -556,6 +556,7 @@ Tcl_GetUnicode( *---------------------------------------------------------------------- */ +#undef Tcl_GetUnicodeFromObj Tcl_UniChar * Tcl_GetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the unicode string @@ -579,6 +580,29 @@ Tcl_GetUnicodeFromObj( } return stringPtr->unicode; } +Tcl_UniChar * +Tcl_GetUnicodeFromObj2( + Tcl_Obj *objPtr, /* The object to find the unicode string + * for. */ + size_t *lengthPtr) /* If non-NULL, the location where the string + * rep's unichar length should be stored. If + * NULL, no length is stored. */ +{ + String *stringPtr; + + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + + if (stringPtr->hasUnicode == 0) { + FillUnicodeRep(objPtr); + stringPtr = GET_STRING(objPtr); + } + + if (lengthPtr != NULL) { + *lengthPtr = stringPtr->numChars; + } + return stringPtr->unicode; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..b765206 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1536,6 +1536,11 @@ const TclStubs tclStubs = { Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ Tcl_OpenTcpServerEx, /* 631 */ + 0, /* 632 */ + 0, /* 633 */ + Tcl_GetValue, /* 634 */ + Tcl_GetStringFromObj2, /* 635 */ + Tcl_GetUnicodeFromObj2, /* 636 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index ebd90ae..5bb99cc 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1733,9 +1733,9 @@ TestdoubledigitsObjCmd(ClientData unused, }; const Tcl_ObjType* doubleType; - double d; + long double d; int status; - int ndigits; + size_t ndigits; int type; int decpt; int signum; @@ -1752,16 +1752,18 @@ TestdoubledigitsObjCmd(ClientData unused, if (status != TCL_OK) { doubleType = Tcl_GetObjType("double"); if (objv[1]->typePtr == doubleType - || TclIsNaN(objv[1]->internalRep.doubleValue)) { + && TclIsNaN(objv[1]->internalRep.doubleValue)) { + double d1; status = TCL_OK; - memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double)); + memcpy(&d1, &(objv[1]->internalRep.doubleValue), sizeof(double)); + d = d1; } } if (status != TCL_OK || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", TCL_EXACT, &type) != TCL_OK) { - fprintf(stderr, "bad value? %g\n", d); + fprintf(stderr, "bad value? %Lg\n", d); return TCL_ERROR; } type = types[type]; @@ -3084,7 +3086,7 @@ TestlinkCmd( } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3142,7 +3144,7 @@ TestlinkCmd( if (argv[15][0]) { Tcl_WideInt w; tmp = Tcl_NewStringObj(argv[15], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3192,7 +3194,7 @@ TestlinkCmd( } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3259,7 +3261,7 @@ TestlinkCmd( if (argv[15][0]) { Tcl_WideInt w; tmp = Tcl_NewStringObj(argv[15], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3527,7 +3529,7 @@ TestparserObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int length, dummy; + size_t length, dummy; Tcl_Parse parse; if (objc != 3) { @@ -3583,7 +3585,7 @@ TestexprparserObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int length, dummy; + size_t length, dummy; Tcl_Parse parse; if (objc != 3) { @@ -3870,7 +3872,7 @@ TestprintObjCmd( } if (objc > 1) { - Tcl_GetWideIntFromObj(interp, objv[2], &argv1); + Tcl_GetIntFromObj(interp, objv[2], &argv1); } argv2 = (size_t)argv1; Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2)); diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 5627608..f08b893 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1163,7 +1163,8 @@ TeststringobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; - int varIndex, option, i, length; + int varIndex, option; + size_t length, i; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; @@ -1230,7 +1231,7 @@ TeststringobjCmd( if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } - for (i = 3; i < objc; i++) { + for (i = 3; i < (size_t)objc; i++) { strings[i-3] = Tcl_GetString(objv[i]); } for ( ; i < 12 + 3; i++) { -- cgit v0.12 From 57102e40e92f6bcde3433f2971c5f9c891cbaec5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Aug 2018 18:03:27 +0000 Subject: Experiment, resolving platform differences at script level. Don't look ... --- generic/tclBasic.c | 47 +---------- generic/tclCmdMZ.c | 7 +- generic/tclCompCmdsSZ.c | 3 - generic/tclExecute.c | 11 +-- generic/tclInt.h | 4 +- generic/tclObj.c | 6 +- generic/tclStubInit.c | 4 +- tests/compExpr-old.test | 6 +- tests/expr.test | 219 ++++++++++++++++++++++++------------------------ tests/format.test | 15 ++-- tests/obj.test | 16 ++-- tests/scan.test | 4 +- tests/string.test | 12 +-- tests/uplevel.test | 16 ++-- 14 files changed, 149 insertions(+), 221 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 81e1927..b7a6a24 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -116,7 +116,6 @@ static Tcl_ObjCmdProc ExprCeilFunc; static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprEntierFunc; static Tcl_ObjCmdProc ExprFloorFunc; -static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; @@ -125,7 +124,7 @@ static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; -static Tcl_ObjCmdProc ExprWideFunc; +static Tcl_ObjCmdProc ExprIntFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -336,7 +335,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "srand", ExprSrandFunc, NULL }, { "tan", ExprUnaryFunc, (ClientData) tan }, { "tanh", ExprUnaryFunc, (ClientData) tanh }, - { "wide", ExprWideFunc, NULL }, + { "wide", ExprIntFunc, NULL }, { NULL, NULL, NULL } }; @@ -3660,16 +3659,8 @@ OldMathFuncProc( args[k].doubleValue = d; break; case TCL_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) { + if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { ckfree(args); return TCL_ERROR; } @@ -7680,38 +7671,6 @@ ExprIntFunc( int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { - long iResult; - Tcl_Obj *objPtr; - if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) { - return TCL_ERROR; - } - objPtr = Tcl_GetObjResult(interp); - if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) { - /* - * Truncate the bignum; keep only bits in long range. - */ - - mp_int big; - - Tcl_GetBignumFromObj(NULL, objPtr, &big); - mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); - objPtr = Tcl_NewBignumObj(&big); - Tcl_IncrRefCount(objPtr); - TclGetLongFromObj(NULL, objPtr, &iResult); - Tcl_DecrRefCount(objPtr); - } - Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult)); - return TCL_OK; -} - -static int -ExprWideFunc( - ClientData clientData, /* Ignored. */ - Tcl_Interp *interp, /* The interpreter in which to execute the - * function. */ - int objc, /* Actual parameter count. */ - Tcl_Obj *const *objv) /* Actual parameter vector. */ -{ Tcl_WideInt wResult; Tcl_Obj *objPtr; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 0bd6cb4..f99a4a0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1622,11 +1622,6 @@ StringIsCmd( case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; - case STR_IS_INT: - if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) { - break; - } - goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || (objPtr->typePtr == &tclBignumType)) { @@ -1669,12 +1664,12 @@ StringIsCmd( failat = 0; } break; + case STR_IS_INT: case STR_IS_WIDE: if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { break; } - failedIntParse: string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 9434e54..8ab1ffa 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -692,9 +692,6 @@ TclCompileStringIsCmd( switch (t) { case STR_IS_INT: - PUSH( "1"); - OP( EQ); - break; case STR_IS_WIDE: PUSH( "2"); OP( LE); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 82de752..034bfd2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5634,18 +5634,9 @@ TEBCresume( case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; - } else if (type1 == TCL_NUMBER_WIDE) { - /* value is between LLONG_MIN and LLONG_MAX */ - /* [string is integer] is -UINT_MAX to UINT_MAX range */ - /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */ - int i; - - if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { - type1 = TCL_NUMBER_LONG; - } } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the LLONG_MIN to LLONG_MAX range */ - /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */ + /* [string is wideinteger] is LLONG_MIN to LLONG_MAX range */ Tcl_WideInt w; if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 64e7c67..c1e24f5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2493,7 +2493,7 @@ typedef struct List { #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType \ - && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \ + && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX)) \ ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) @@ -2501,7 +2501,7 @@ typedef struct List { #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType \ - && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \ + && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \ ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) diff --git a/generic/tclObj.c b/generic/tclObj.c index e10cbd7..40c27d5 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2563,7 +2563,7 @@ Tcl_GetIntFromObj( if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) { return TCL_ERROR; } - if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) { + if ((ULONG_MAX > UINT_MAX) && ((l > (long)(UINT_MAX)) || (l < (long)(INT_MIN)))) { if (interp != NULL) { const char *s = "integer value too large to represent as non-long integer"; @@ -2870,7 +2870,7 @@ Tcl_GetLongFromObj( #else if (objPtr->typePtr == &tclIntType) { /* - * We return any integer in the range -ULONG_MAX to ULONG_MAX + * We return any integer in the range LONG_MIN to ULONG_MAX * converted to a long, ignoring overflow. The rule preserves * existing semantics for conversion of integers on input, but * avoids inadvertent demotion of wide integers to 32-bit ones in @@ -2879,7 +2879,7 @@ Tcl_GetLongFromObj( Tcl_WideInt w = objPtr->internalRep.wideValue; - if (w >= -(Tcl_WideInt)(ULONG_MAX) + if (w >= (Tcl_WideInt)(LONG_MIN) && w <= (Tcl_WideInt)(ULONG_MAX)) { *longPtr = Tcl_WideAsLong(w); return TCL_OK; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a3641f9..94b5561 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -271,7 +271,7 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ long longValue; int result = Tcl_ExprLong(interp, expr, &longValue); if (result == TCL_OK) { - if ((longValue >= -(long)(UINT_MAX)) + if ((longValue >= (long)(INT_MIN)) && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { @@ -287,7 +287,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ long longValue; int result = Tcl_ExprLongObj(interp, expr, &longValue); if (result == TCL_OK) { - if ((longValue >= -(long)(UINT_MAX)) + if ((longValue >= (long)(INT_MIN)) && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 0136ccd..4354520 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -79,7 +79,6 @@ proc testIEEE {} { testConstraint ieeeFloatingPoint [testIEEE] testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] # procedures used below @@ -335,12 +334,9 @@ test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 # The following test is different for 32-bit versus 64-bit # architectures because LONG_MIN is different -test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { +test compExpr-old-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} { expr {int(1<<63)} } -9223372036854775808 -test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { - expr {int(1<<31)} -} -2147483648 test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 diff --git a/tests/expr.test b/tests/expr.test index 713681a..30a80ad 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -18,13 +18,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::tcltest::loadTestedCommands 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. +# Determine if "long int" type is a 32 bit number. testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] -testConstraint wideIs64bit \ - [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] # Big test for correct ordering of data in [expr] @@ -5846,7 +5843,7 @@ test expr-33.2 {parse smallest long value} longIs32bit { [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \ } {-2147483648 -2147483648 -2147483648 -2147483648 1 1} -test expr-33.3 {parse largest wide value} wideIs64bit { +test expr-33.3 {parse largest wide value} { set max_wide_str 9223372036854775807 set max_wide_hex "0x7FFFFFFFFFFFFFFF " @@ -5863,7 +5860,7 @@ test expr-33.3 {parse largest wide value} wideIs64bit { [expr {wide(9223372036854775807 + 1) < 0}] \ } {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1} -test expr-33.4 {parse smallest wide value} wideIs64bit { +test expr-33.4 {parse smallest wide value} { set min_wide_str -9223372036854775808 set min_wide_hex "-0x8000000000000000 " @@ -6271,341 +6268,341 @@ test expr-35.14 {expr edge cases} { set min -9223372036854775808 set max 9223372036854775807 -test expr-36.1 {expr edge cases} {wideIs64bit} { +test expr-36.1 {expr edge cases} { expr {$min / $min} } {1} -test expr-36.2 {expr edge cases} {wideIs64bit} { +test expr-36.2 {expr edge cases} { expr {$min % $min} } {0} -test expr-36.3 {expr edge cases} {wideIs64bit} { +test expr-36.3 {expr edge cases} { expr {$min / ($min + 1)} } {1} -test expr-36.4 {expr edge cases} {wideIs64bit} { +test expr-36.4 {expr edge cases} { expr {$min % ($min + 1)} } {-1} -test expr-36.5 {expr edge cases} {wideIs64bit} { +test expr-36.5 {expr edge cases} { expr {$min / ($min + 2)} } {1} -test expr-36.6 {expr edge cases} {wideIs64bit} { +test expr-36.6 {expr edge cases} { expr {$min % ($min + 2)} } {-2} -test expr-36.7 {expr edge cases} {wideIs64bit} { +test expr-36.7 {expr edge cases} { expr {$min / ($min + 3)} } {1} -test expr-36.8 {expr edge cases} {wideIs64bit} { +test expr-36.8 {expr edge cases} { expr {$min % ($min + 3)} } {-3} -test expr-36.9 {expr edge cases} {wideIs64bit} { +test expr-36.9 {expr edge cases} { expr {$min / -3} } {3074457345618258602} -test expr-36.10 {expr edge cases} {wideIs64bit} { +test expr-36.10 {expr edge cases} { expr {$min % -3} } {-2} -test expr-36.11 {expr edge cases} {wideIs64bit} { +test expr-36.11 {expr edge cases} { expr {$min / -2} } {4611686018427387904} -test expr-36.12 {expr edge cases} {wideIs64bit} { +test expr-36.12 {expr edge cases} { expr {$min % -2} } {0} -test expr-36.13 {expr edge cases} wideIs64bit { +test expr-36.13 {expr edge cases} { expr {wide($min / -1)} } $min -test expr-36.14 {expr edge cases} {wideIs64bit} { +test expr-36.14 {expr edge cases} { expr {$min % -1} } {0} -test expr-36.15 {expr edge cases} wideIs64bit { +test expr-36.15 {expr edge cases} { expr {wide($min * -1)} } $min -test expr-36.16 {expr edge cases} wideIs64bit { +test expr-36.16 {expr edge cases} { expr {wide(-$min)} } $min -test expr-36.17 {expr edge cases} {wideIs64bit} { +test expr-36.17 {expr edge cases} { expr {$min / 1} } $min -test expr-36.18 {expr edge cases} {wideIs64bit} { +test expr-36.18 {expr edge cases} { expr {$min % 1} } {0} -test expr-36.19 {expr edge cases} {wideIs64bit} { +test expr-36.19 {expr edge cases} { expr {$min / 2} } {-4611686018427387904} -test expr-36.20 {expr edge cases} {wideIs64bit} { +test expr-36.20 {expr edge cases} { expr {$min % 2} } {0} -test expr-36.21 {expr edge cases} {wideIs64bit} { +test expr-36.21 {expr edge cases} { expr {$min / 3} } {-3074457345618258603} -test expr-36.22 {expr edge cases} {wideIs64bit} { +test expr-36.22 {expr edge cases} { expr {$min % 3} } {1} -test expr-36.23 {expr edge cases} {wideIs64bit} { +test expr-36.23 {expr edge cases} { expr {$min / ($max - 3)} } {-2} -test expr-36.24 {expr edge cases} {wideIs64bit} { +test expr-36.24 {expr edge cases} { expr {$min % ($max - 3)} } {9223372036854775800} -test expr-36.25 {expr edge cases} {wideIs64bit} { +test expr-36.25 {expr edge cases} { expr {$min / ($max - 2)} } {-2} -test expr-36.26 {expr edge cases} {wideIs64bit} { +test expr-36.26 {expr edge cases} { expr {$min % ($max - 2)} } {9223372036854775802} -test expr-36.27 {expr edge cases} {wideIs64bit} { +test expr-36.27 {expr edge cases} { expr {$min / ($max - 1)} } {-2} -test expr-36.28 {expr edge cases} {wideIs64bit} { +test expr-36.28 {expr edge cases} { expr {$min % ($max - 1)} } {9223372036854775804} -test expr-36.29 {expr edge cases} {wideIs64bit} { +test expr-36.29 {expr edge cases} { expr {$min / $max} } {-2} -test expr-36.30 {expr edge cases} {wideIs64bit} { +test expr-36.30 {expr edge cases} { expr {$min % $max} } {9223372036854775806} -test expr-36.31 {expr edge cases} {wideIs64bit} { +test expr-36.31 {expr edge cases} { expr {$max / $max} } {1} -test expr-36.32 {expr edge cases} {wideIs64bit} { +test expr-36.32 {expr edge cases} { expr {$max % $max} } {0} -test expr-36.33 {expr edge cases} {wideIs64bit} { +test expr-36.33 {expr edge cases} { expr {$max / ($max - 1)} } {1} -test expr-36.34 {expr edge cases} {wideIs64bit} { +test expr-36.34 {expr edge cases} { expr {$max % ($max - 1)} } {1} -test expr-36.35 {expr edge cases} {wideIs64bit} { +test expr-36.35 {expr edge cases} { expr {$max / ($max - 2)} } {1} -test expr-36.36 {expr edge cases} {wideIs64bit} { +test expr-36.36 {expr edge cases} { expr {$max % ($max - 2)} } {2} -test expr-36.37 {expr edge cases} {wideIs64bit} { +test expr-36.37 {expr edge cases} { expr {$max / ($max - 3)} } {1} -test expr-36.38 {expr edge cases} {wideIs64bit} { +test expr-36.38 {expr edge cases} { expr {$max % ($max - 3)} } {3} -test expr-36.39 {expr edge cases} {wideIs64bit} { +test expr-36.39 {expr edge cases} { expr {$max / 3} } {3074457345618258602} -test expr-36.40 {expr edge cases} {wideIs64bit} { +test expr-36.40 {expr edge cases} { expr {$max % 3} } {1} -test expr-36.41 {expr edge cases} {wideIs64bit} { +test expr-36.41 {expr edge cases} { expr {$max / 2} } {4611686018427387903} -test expr-36.42 {expr edge cases} {wideIs64bit} { +test expr-36.42 {expr edge cases} { expr {$max % 2} } {1} -test expr-36.43 {expr edge cases} {wideIs64bit} { +test expr-36.43 {expr edge cases} { expr {$max / 1} } $max -test expr-36.44 {expr edge cases} {wideIs64bit} { +test expr-36.44 {expr edge cases} { expr {$max % 1} } {0} -test expr-36.45 {expr edge cases} {wideIs64bit} { +test expr-36.45 {expr edge cases} { expr {$max / -1} } "-$max" -test expr-36.46 {expr edge cases} {wideIs64bit} { +test expr-36.46 {expr edge cases} { expr {$max % -1} } {0} -test expr-36.47 {expr edge cases} {wideIs64bit} { +test expr-36.47 {expr edge cases} { expr {$max / -2} } {-4611686018427387904} -test expr-36.48 {expr edge cases} {wideIs64bit} { +test expr-36.48 {expr edge cases} { expr {$max % -2} } {-1} -test expr-36.49 {expr edge cases} {wideIs64bit} { +test expr-36.49 {expr edge cases} { expr {$max / -3} } {-3074457345618258603} -test expr-36.50 {expr edge cases} {wideIs64bit} { +test expr-36.50 {expr edge cases} { expr {$max % -3} } {-2} -test expr-36.51 {expr edge cases} {wideIs64bit} { +test expr-36.51 {expr edge cases} { expr {$max / ($min + 3)} } {-2} -test expr-36.52 {expr edge cases} {wideIs64bit} { +test expr-36.52 {expr edge cases} { expr {$max % ($min + 3)} } {-9223372036854775803} -test expr-36.53 {expr edge cases} {wideIs64bit} { +test expr-36.53 {expr edge cases} { expr {$max / ($min + 2)} } {-2} -test expr-36.54 {expr edge cases} {wideIs64bit} { +test expr-36.54 {expr edge cases} { expr {$max % ($min + 2)} } {-9223372036854775805} -test expr-36.55 {expr edge cases} {wideIs64bit} { +test expr-36.55 {expr edge cases} { expr {$max / ($min + 1)} } {-1} -test expr-36.56 {expr edge cases} {wideIs64bit} { +test expr-36.56 {expr edge cases} { expr {$max % ($min + 1)} } {0} -test expr-36.57 {expr edge cases} {wideIs64bit} { +test expr-36.57 {expr edge cases} { expr {$max / $min} } {-1} -test expr-36.58 {expr edge cases} {wideIs64bit} { +test expr-36.58 {expr edge cases} { expr {$max % $min} } {-1} -test expr-36.59 {expr edge cases} {wideIs64bit} { +test expr-36.59 {expr edge cases} { expr {($min + 1) / ($max - 1)} } {-2} -test expr-36.60 {expr edge cases} {wideIs64bit} { +test expr-36.60 {expr edge cases} { expr {($min + 1) % ($max - 1)} } {9223372036854775805} -test expr-36.61 {expr edge cases} {wideIs64bit} { +test expr-36.61 {expr edge cases} { expr {($max - 1) / ($min + 1)} } {-1} -test expr-36.62 {expr edge cases} {wideIs64bit} { +test expr-36.62 {expr edge cases} { expr {($max - 1) % ($min + 1)} } {-1} -test expr-36.63 {expr edge cases} {wideIs64bit} { +test expr-36.63 {expr edge cases} { expr {($max - 1) / $min} } {-1} -test expr-36.64 {expr edge cases} {wideIs64bit} { +test expr-36.64 {expr edge cases} { expr {($max - 1) % $min} } {-2} -test expr-36.65 {expr edge cases} {wideIs64bit} { +test expr-36.65 {expr edge cases} { expr {($max - 2) / $min} } {-1} -test expr-36.66 {expr edge cases} {wideIs64bit} { +test expr-36.66 {expr edge cases} { expr {($max - 2) % $min} } {-3} -test expr-36.67 {expr edge cases} {wideIs64bit} { +test expr-36.67 {expr edge cases} { expr {($max - 3) / $min} } {-1} -test expr-36.68 {expr edge cases} {wideIs64bit} { +test expr-36.68 {expr edge cases} { expr {($max - 3) % $min} } {-4} -test expr-36.69 {expr edge cases} {wideIs64bit} { +test expr-36.69 {expr edge cases} { expr {-3 / $min} } {0} -test expr-36.70 {expr edge cases} {wideIs64bit} { +test expr-36.70 {expr edge cases} { expr {-3 % $min} } {-3} -test expr-36.71 {expr edge cases} {wideIs64bit} { +test expr-36.71 {expr edge cases} { expr {-2 / $min} } {0} -test expr-36.72 {expr edge cases} {wideIs64bit} { +test expr-36.72 {expr edge cases} { expr {-2 % $min} } {-2} -test expr-36.73 {expr edge cases} {wideIs64bit} { +test expr-36.73 {expr edge cases} { expr {-1 / $min} } {0} -test expr-36.74 {expr edge cases} {wideIs64bit} { +test expr-36.74 {expr edge cases} { expr {-1 % $min} } {-1} -test expr-36.75 {expr edge cases} {wideIs64bit} { +test expr-36.75 {expr edge cases} { expr {0 / $min} } {0} -test expr-36.76 {expr edge cases} {wideIs64bit} { +test expr-36.76 {expr edge cases} { expr {0 % $min} } {0} -test expr-36.77 {expr edge cases} {wideIs64bit} { +test expr-36.77 {expr edge cases} { expr {0 / ($min + 1)} } {0} -test expr-36.78 {expr edge cases} {wideIs64bit} { +test expr-36.78 {expr edge cases} { expr {0 % ($min + 1)} } {0} -test expr-36.79 {expr edge cases} {wideIs64bit} { +test expr-36.79 {expr edge cases} { expr {1 / $min} } {-1} -test expr-36.80 {expr edge cases} {wideIs64bit} { +test expr-36.80 {expr edge cases} { expr {1 % $min} } {-9223372036854775807} -test expr-36.81 {expr edge cases} {wideIs64bit} { +test expr-36.81 {expr edge cases} { expr {1 / ($min + 1)} } {-1} -test expr-36.82 {expr edge cases} {wideIs64bit} { +test expr-36.82 {expr edge cases} { expr {1 % ($min + 1)} } {-9223372036854775806} -test expr-36.83 {expr edge cases} {wideIs64bit} { +test expr-36.83 {expr edge cases} { expr {2 / $min} } {-1} -test expr-36.84 {expr edge cases} {wideIs64bit} { +test expr-36.84 {expr edge cases} { expr {2 % $min} } {-9223372036854775806} -test expr-36.85 {expr edge cases} {wideIs64bit} { +test expr-36.85 {expr edge cases} { expr {2 / ($min + 1)} } {-1} -test expr-36.86 {expr edge cases} {wideIs64bit} { +test expr-36.86 {expr edge cases} { expr {2 % ($min + 1)} } {-9223372036854775805} -test expr-36.87 {expr edge cases} {wideIs64bit} { +test expr-36.87 {expr edge cases} { expr {3 / $min} } {-1} -test expr-36.88 {expr edge cases} {wideIs64bit} { +test expr-36.88 {expr edge cases} { expr {3 % $min} } {-9223372036854775805} -test expr-36.89 {expr edge cases} {wideIs64bit} { +test expr-36.89 {expr edge cases} { expr {3 / ($min + 1)} } {-1} -test expr-36.90 {expr edge cases} {wideIs64bit} { +test expr-36.90 {expr edge cases} { expr {3 % ($min + 1)} } {-9223372036854775804} -test expr-37.1 {expr edge cases} {wideIs64bit} { +test expr-37.1 {expr edge cases} { set dividend $max set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($divisor * $q) + $r}] } {4611686018427387903 * 2 + 1 = 9223372036854775807} -test expr-37.2 {expr edge cases} {wideIs64bit} { +test expr-37.2 {expr edge cases} { set dividend [expr {$max - 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {4611686018427387903 * 2 + 0 = 9223372036854775806} -test expr-37.3 {expr edge cases} {wideIs64bit} { +test expr-37.3 {expr edge cases} { set dividend [expr {$max - 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {4611686018427387902 * 2 + 1 = 9223372036854775805} -test expr-37.4 {expr edge cases} {wideIs64bit} { +test expr-37.4 {expr edge cases} { set dividend $max set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * 3 + 1 = 9223372036854775807} -test expr-37.5 {expr edge cases} {wideIs64bit} { +test expr-37.5 {expr edge cases} { set dividend [expr {$max - 1}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * 3 + 0 = 9223372036854775806} -test expr-37.6 {expr edge cases} {wideIs64bit} { +test expr-37.6 {expr edge cases} { set dividend [expr {$max - 2}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258601 * 3 + 2 = 9223372036854775805} -test expr-37.7 {expr edge cases} {wideIs64bit} { +test expr-37.7 {expr edge cases} { set dividend $min set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387904 * 2 + 0 = -9223372036854775808} -test expr-37.8 {expr edge cases} {wideIs64bit} { +test expr-37.8 {expr edge cases} { set dividend [expr {$min + 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387904 * 2 + 1 = -9223372036854775807} -test expr-37.9 {expr edge cases} {wideIs64bit} { +test expr-37.9 {expr edge cases} { set dividend [expr {$min + 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387903 * 2 + 0 = -9223372036854775806} -test expr-37.10 {expr edge cases} {wideIs64bit} { +test expr-37.10 {expr edge cases} { # Multiplication overflows 64 bit type here, # so when the 1 is added it overflows # again and we end up back at min. @@ -6615,28 +6612,28 @@ test expr-37.10 {expr edge cases} {wideIs64bit} { set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-3074457345618258603 * 3 + 1 = -9223372036854775808} -test expr-37.11 {expr edge cases} {wideIs64bit} { +test expr-37.11 {expr edge cases} { set dividend $min set divisor -3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * -3 + -2 = -9223372036854775808} -test expr-37.12 {expr edge cases} {wideIs64bit} { +test expr-37.12 {expr edge cases} { set dividend $min set divisor $min set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775808 + 0 = -9223372036854775808} -test expr-37.13 {expr edge cases} {wideIs64bit} { +test expr-37.13 {expr edge cases} { set dividend $min set divisor [expr {$min + 1}] set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775807 + -1 = -9223372036854775808} -test expr-37.14 {expr edge cases} {wideIs64bit} { +test expr-37.14 {expr edge cases} { set dividend $min set divisor [expr {$min + 2}] set q [expr {$dividend / $divisor}] @@ -6644,7 +6641,7 @@ test expr-37.14 {expr edge cases} {wideIs64bit} { list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775806 + -2 = -9223372036854775808} -test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { +test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} { expr {abs(-2147483648)} } 2147483648 test expr-38.2 {abs and -0 [Bug 1893815]} { diff --git a/tests/format.test b/tests/format.test index cdea545..ff85cb2 100644 --- a/tests/format.test +++ b/tests/format.test @@ -18,9 +18,6 @@ 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 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,13 +544,13 @@ 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} { format %d 7810179016327718216 -} 1819043144 -test format-17.2 {testing %ld with wide} {wideIs64bit} { +} 7810179016327718216 +test format-17.2 {testing %ld with wide} { format %ld 7810179016327718216 } 7810179016327718216 -test format-17.3 {testing %ld with non-wide} {wideIs64bit} { +test format-17.3 {testing %ld with non-wide} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { @@ -580,11 +577,11 @@ 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} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] -} {aaaaaaab 1} +} {aaaaaaaaab 1} test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body { set x 0x8fedc654 diff --git a/tests/obj.test b/tests/obj.test index cb62d3f..41b1428 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -20,8 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { 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 +547,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} { 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} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] -} {0 4294967296} -test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +} {1 4294967296} +test obj-33.4 {integer overflow on input} { 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} { 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} { 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 -0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] -} {0 -4294967296} +} {1 -4294967296} test obj-34.1 {mp_iseven} testobj { set result "" diff --git a/tests/scan.test b/tests/scan.test index 1f32b9f..0b7b14a 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -85,8 +85,6 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint wideIs64bit \ - [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x @@ -521,7 +519,7 @@ test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} -test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup { +test scan-5.12 {integer scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ diff --git a/tests/string.test b/tests/string.test index d169193..81588ff 100644 --- a/tests/string.test +++ b/tests/string.test @@ -807,20 +807,20 @@ 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, 32-bit overflow} { +test string-6.92.$noComp {string is integer, 64-bit overflow} { # Bug 718878 - set x 0x100000000 + set x 0x10000000000000000 list [run {string is integer -failindex var $x}] $var } {0 -1} -test string-6.93.$noComp {string is integer, 32-bit overflow} { +test string-6.93.$noComp {string is integer, 64-bit overflow} { # Bug 718878 - set x 0x100000000 + set x 0x10000000000000000 append x "" list [run {string is integer -failindex var $x}] $var } {0 -1} -test string-6.94.$noComp {string is integer, 32-bit overflow} { +test string-6.94.$noComp {string is integer, 64-bit overflow} { # Bug 718878 - set x 0x100000000 + set x 0x10000000000000000 list [run {string is integer -failindex var [expr {$x}]}] $var } {0 -1} test string-6.95.$noComp {string is wideinteger, true} { diff --git a/tests/uplevel.test b/tests/uplevel.test index 737c571..83d6b42 100644 --- a/tests/uplevel.test +++ b/tests/uplevel.test @@ -137,18 +137,18 @@ test uplevel-4.15 {level parsing} { test uplevel-4.16 {level parsing} { apply {{} {uplevel #[expr 1] {}}} } {} -test uplevel-4.17 {level parsing} { +test uplevel-4.17 {level parsing} -returnCodes error -body { apply {{} {uplevel -0xffffffff {}}} -} {} -test uplevel-4.18 {level parsing} { +} -result {invalid command name "-0xffffffff"} +test uplevel-4.18 {level parsing} -returnCodes error -body { apply {{} {uplevel #-0xffffffff {}}} -} {} -test uplevel-4.19 {level parsing} { +} -result {bad level "#-0xffffffff"} +test uplevel-4.19 {level parsing} -returnCodes error -body { apply {{} {uplevel [expr -0xffffffff] {}}} -} {} -test uplevel-4.20 {level parsing} { +} -result {invalid command name "-4294967295"} +test uplevel-4.20 {level parsing} -returnCodes error -body { apply {{} {uplevel #[expr -0xffffffff] {}}} -} {} +} -result {bad level "#-4294967295"} test uplevel-4.21 {level parsing} -body { apply {{} {uplevel -1 {}}} } -returnCodes error -result {invalid command name "-1"} -- cgit v0.12 From 51ce0579e8d61cfce32dbe6ad2d2894ec6de60f7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Aug 2018 18:13:31 +0000 Subject: Few more test-cases --- tests/compExpr-old.test | 2 -- tests/execute.test | 15 +++++++-------- tests/expr.test | 5 +---- 3 files changed, 8 insertions(+), 14 deletions(-) diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 4354520..267b228 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -78,8 +78,6 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] - # procedures used below proc put_hello_char {c} { diff --git a/tests/execute.test b/tests/execute.test index 6c277f8..ac97c6c 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -34,7 +34,6 @@ testConstraint testobj [expr { && [llength [info commands teststringobj]] }] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] # Tests for the omnibus TclExecuteByteCode function: @@ -805,9 +804,9 @@ test execute-7.7 {Wide int handling in INST_EQ and [incr]} { set y [expr {$x+1}] expr {double($x) == double($y)} } 1 -test execute-7.8 {Wide int conversions can change sign} longIs32bit { - set x 0x80000000 - expr {int($x) < wide($x)} +test execute-7.8 {Wide int conversions can change sign} { + set x 0x8000000000000000 + expr {int($x) < $x} } 1 test execute-7.9 {Wide int handling in INST_MOD} { expr {(wide(1)<<60) % ((wide(47)<<45)-1)} @@ -887,11 +886,11 @@ test execute-7.31 {Wide int handling in abs()} { set y 0x123456871234568 concat [expr {abs($x)}] [expr {abs($y)}] } {730503879441204585 81985533099853160} -test execute-7.32 {Wide int handling} longIs32bit { - expr {int(1024 * 1024 * 1024 * 1024)} +test execute-7.32 {Wide int handling} { + expr {int(1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024)} } 0 -test execute-7.33 {Wide int handling} longIs32bit { - expr {int(0x1 * 1024 * 1024 * 1024 * 1024)} +test execute-7.33 {Wide int handling} { + expr {int(0x1 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024)} } 0 test execute-7.34 {Wide int handling} { expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} diff --git a/tests/expr.test b/tests/expr.test index 30a80ad..9f36823 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -414,12 +414,9 @@ test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 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 { +test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} { expr {int(1<<63)} } -9223372036854775808 -test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { - expr {int(1<<31)} -} -2147483648 test expr-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 } -returnCodes error -match glob -result * -- cgit v0.12 From c475df7cfbfab932ff2a21678fa244094c7c49ee Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Aug 2018 18:54:44 +0000 Subject: Undo various test-case changes, in order to prove platform compatibility --- tests/compExpr-old.test | 8 +- tests/execute.test | 15 ++-- tests/expr.test | 224 +++++++++++++++++++++++++----------------------- tests/format.test | 15 ++-- tests/obj.test | 24 +++--- tests/scan.test | 4 +- 6 files changed, 155 insertions(+), 135 deletions(-) diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 267b228..0136ccd 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -78,6 +78,9 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] +testConstraint longIs32bit [expr {int(0x80000000) < 0}] +testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] + # procedures used below proc put_hello_char {c} { @@ -332,9 +335,12 @@ test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 # The following test is different for 32-bit versus 64-bit # architectures because LONG_MIN is different -test compExpr-old-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} { +test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { expr {int(1<<63)} } -9223372036854775808 +test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { + expr {int(1<<31)} +} -2147483648 test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 diff --git a/tests/execute.test b/tests/execute.test index ac97c6c..6c277f8 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -34,6 +34,7 @@ testConstraint testobj [expr { && [llength [info commands teststringobj]] }] +testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] # Tests for the omnibus TclExecuteByteCode function: @@ -804,9 +805,9 @@ test execute-7.7 {Wide int handling in INST_EQ and [incr]} { set y [expr {$x+1}] expr {double($x) == double($y)} } 1 -test execute-7.8 {Wide int conversions can change sign} { - set x 0x8000000000000000 - expr {int($x) < $x} +test execute-7.8 {Wide int conversions can change sign} longIs32bit { + set x 0x80000000 + expr {int($x) < wide($x)} } 1 test execute-7.9 {Wide int handling in INST_MOD} { expr {(wide(1)<<60) % ((wide(47)<<45)-1)} @@ -886,11 +887,11 @@ test execute-7.31 {Wide int handling in abs()} { set y 0x123456871234568 concat [expr {abs($x)}] [expr {abs($y)}] } {730503879441204585 81985533099853160} -test execute-7.32 {Wide int handling} { - expr {int(1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024)} +test execute-7.32 {Wide int handling} longIs32bit { + expr {int(1024 * 1024 * 1024 * 1024)} } 0 -test execute-7.33 {Wide int handling} { - expr {int(0x1 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024)} +test execute-7.33 {Wide int handling} longIs32bit { + expr {int(0x1 * 1024 * 1024 * 1024 * 1024)} } 0 test execute-7.34 {Wide int handling} { expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} diff --git a/tests/expr.test b/tests/expr.test index 9f36823..713681a 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -18,10 +18,13 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] -# Determine if "long int" type is a 32 bit number. +# 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 wideIs64bit \ + [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] # Big test for correct ordering of data in [expr] @@ -414,9 +417,12 @@ test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 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.5 {CompileRelationalExpr: shift expr producing LONG_MIN} { +test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { expr {int(1<<63)} } -9223372036854775808 +test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { + expr {int(1<<31)} +} -2147483648 test expr-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 } -returnCodes error -match glob -result * @@ -5840,7 +5846,7 @@ test expr-33.2 {parse smallest long value} longIs32bit { [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \ } {-2147483648 -2147483648 -2147483648 -2147483648 1 1} -test expr-33.3 {parse largest wide value} { +test expr-33.3 {parse largest wide value} wideIs64bit { set max_wide_str 9223372036854775807 set max_wide_hex "0x7FFFFFFFFFFFFFFF " @@ -5857,7 +5863,7 @@ test expr-33.3 {parse largest wide value} { [expr {wide(9223372036854775807 + 1) < 0}] \ } {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1} -test expr-33.4 {parse smallest wide value} { +test expr-33.4 {parse smallest wide value} wideIs64bit { set min_wide_str -9223372036854775808 set min_wide_hex "-0x8000000000000000 " @@ -6265,341 +6271,341 @@ test expr-35.14 {expr edge cases} { set min -9223372036854775808 set max 9223372036854775807 -test expr-36.1 {expr edge cases} { +test expr-36.1 {expr edge cases} {wideIs64bit} { expr {$min / $min} } {1} -test expr-36.2 {expr edge cases} { +test expr-36.2 {expr edge cases} {wideIs64bit} { expr {$min % $min} } {0} -test expr-36.3 {expr edge cases} { +test expr-36.3 {expr edge cases} {wideIs64bit} { expr {$min / ($min + 1)} } {1} -test expr-36.4 {expr edge cases} { +test expr-36.4 {expr edge cases} {wideIs64bit} { expr {$min % ($min + 1)} } {-1} -test expr-36.5 {expr edge cases} { +test expr-36.5 {expr edge cases} {wideIs64bit} { expr {$min / ($min + 2)} } {1} -test expr-36.6 {expr edge cases} { +test expr-36.6 {expr edge cases} {wideIs64bit} { expr {$min % ($min + 2)} } {-2} -test expr-36.7 {expr edge cases} { +test expr-36.7 {expr edge cases} {wideIs64bit} { expr {$min / ($min + 3)} } {1} -test expr-36.8 {expr edge cases} { +test expr-36.8 {expr edge cases} {wideIs64bit} { expr {$min % ($min + 3)} } {-3} -test expr-36.9 {expr edge cases} { +test expr-36.9 {expr edge cases} {wideIs64bit} { expr {$min / -3} } {3074457345618258602} -test expr-36.10 {expr edge cases} { +test expr-36.10 {expr edge cases} {wideIs64bit} { expr {$min % -3} } {-2} -test expr-36.11 {expr edge cases} { +test expr-36.11 {expr edge cases} {wideIs64bit} { expr {$min / -2} } {4611686018427387904} -test expr-36.12 {expr edge cases} { +test expr-36.12 {expr edge cases} {wideIs64bit} { expr {$min % -2} } {0} -test expr-36.13 {expr edge cases} { +test expr-36.13 {expr edge cases} wideIs64bit { expr {wide($min / -1)} } $min -test expr-36.14 {expr edge cases} { +test expr-36.14 {expr edge cases} {wideIs64bit} { expr {$min % -1} } {0} -test expr-36.15 {expr edge cases} { +test expr-36.15 {expr edge cases} wideIs64bit { expr {wide($min * -1)} } $min -test expr-36.16 {expr edge cases} { +test expr-36.16 {expr edge cases} wideIs64bit { expr {wide(-$min)} } $min -test expr-36.17 {expr edge cases} { +test expr-36.17 {expr edge cases} {wideIs64bit} { expr {$min / 1} } $min -test expr-36.18 {expr edge cases} { +test expr-36.18 {expr edge cases} {wideIs64bit} { expr {$min % 1} } {0} -test expr-36.19 {expr edge cases} { +test expr-36.19 {expr edge cases} {wideIs64bit} { expr {$min / 2} } {-4611686018427387904} -test expr-36.20 {expr edge cases} { +test expr-36.20 {expr edge cases} {wideIs64bit} { expr {$min % 2} } {0} -test expr-36.21 {expr edge cases} { +test expr-36.21 {expr edge cases} {wideIs64bit} { expr {$min / 3} } {-3074457345618258603} -test expr-36.22 {expr edge cases} { +test expr-36.22 {expr edge cases} {wideIs64bit} { expr {$min % 3} } {1} -test expr-36.23 {expr edge cases} { +test expr-36.23 {expr edge cases} {wideIs64bit} { expr {$min / ($max - 3)} } {-2} -test expr-36.24 {expr edge cases} { +test expr-36.24 {expr edge cases} {wideIs64bit} { expr {$min % ($max - 3)} } {9223372036854775800} -test expr-36.25 {expr edge cases} { +test expr-36.25 {expr edge cases} {wideIs64bit} { expr {$min / ($max - 2)} } {-2} -test expr-36.26 {expr edge cases} { +test expr-36.26 {expr edge cases} {wideIs64bit} { expr {$min % ($max - 2)} } {9223372036854775802} -test expr-36.27 {expr edge cases} { +test expr-36.27 {expr edge cases} {wideIs64bit} { expr {$min / ($max - 1)} } {-2} -test expr-36.28 {expr edge cases} { +test expr-36.28 {expr edge cases} {wideIs64bit} { expr {$min % ($max - 1)} } {9223372036854775804} -test expr-36.29 {expr edge cases} { +test expr-36.29 {expr edge cases} {wideIs64bit} { expr {$min / $max} } {-2} -test expr-36.30 {expr edge cases} { +test expr-36.30 {expr edge cases} {wideIs64bit} { expr {$min % $max} } {9223372036854775806} -test expr-36.31 {expr edge cases} { +test expr-36.31 {expr edge cases} {wideIs64bit} { expr {$max / $max} } {1} -test expr-36.32 {expr edge cases} { +test expr-36.32 {expr edge cases} {wideIs64bit} { expr {$max % $max} } {0} -test expr-36.33 {expr edge cases} { +test expr-36.33 {expr edge cases} {wideIs64bit} { expr {$max / ($max - 1)} } {1} -test expr-36.34 {expr edge cases} { +test expr-36.34 {expr edge cases} {wideIs64bit} { expr {$max % ($max - 1)} } {1} -test expr-36.35 {expr edge cases} { +test expr-36.35 {expr edge cases} {wideIs64bit} { expr {$max / ($max - 2)} } {1} -test expr-36.36 {expr edge cases} { +test expr-36.36 {expr edge cases} {wideIs64bit} { expr {$max % ($max - 2)} } {2} -test expr-36.37 {expr edge cases} { +test expr-36.37 {expr edge cases} {wideIs64bit} { expr {$max / ($max - 3)} } {1} -test expr-36.38 {expr edge cases} { +test expr-36.38 {expr edge cases} {wideIs64bit} { expr {$max % ($max - 3)} } {3} -test expr-36.39 {expr edge cases} { +test expr-36.39 {expr edge cases} {wideIs64bit} { expr {$max / 3} } {3074457345618258602} -test expr-36.40 {expr edge cases} { +test expr-36.40 {expr edge cases} {wideIs64bit} { expr {$max % 3} } {1} -test expr-36.41 {expr edge cases} { +test expr-36.41 {expr edge cases} {wideIs64bit} { expr {$max / 2} } {4611686018427387903} -test expr-36.42 {expr edge cases} { +test expr-36.42 {expr edge cases} {wideIs64bit} { expr {$max % 2} } {1} -test expr-36.43 {expr edge cases} { +test expr-36.43 {expr edge cases} {wideIs64bit} { expr {$max / 1} } $max -test expr-36.44 {expr edge cases} { +test expr-36.44 {expr edge cases} {wideIs64bit} { expr {$max % 1} } {0} -test expr-36.45 {expr edge cases} { +test expr-36.45 {expr edge cases} {wideIs64bit} { expr {$max / -1} } "-$max" -test expr-36.46 {expr edge cases} { +test expr-36.46 {expr edge cases} {wideIs64bit} { expr {$max % -1} } {0} -test expr-36.47 {expr edge cases} { +test expr-36.47 {expr edge cases} {wideIs64bit} { expr {$max / -2} } {-4611686018427387904} -test expr-36.48 {expr edge cases} { +test expr-36.48 {expr edge cases} {wideIs64bit} { expr {$max % -2} } {-1} -test expr-36.49 {expr edge cases} { +test expr-36.49 {expr edge cases} {wideIs64bit} { expr {$max / -3} } {-3074457345618258603} -test expr-36.50 {expr edge cases} { +test expr-36.50 {expr edge cases} {wideIs64bit} { expr {$max % -3} } {-2} -test expr-36.51 {expr edge cases} { +test expr-36.51 {expr edge cases} {wideIs64bit} { expr {$max / ($min + 3)} } {-2} -test expr-36.52 {expr edge cases} { +test expr-36.52 {expr edge cases} {wideIs64bit} { expr {$max % ($min + 3)} } {-9223372036854775803} -test expr-36.53 {expr edge cases} { +test expr-36.53 {expr edge cases} {wideIs64bit} { expr {$max / ($min + 2)} } {-2} -test expr-36.54 {expr edge cases} { +test expr-36.54 {expr edge cases} {wideIs64bit} { expr {$max % ($min + 2)} } {-9223372036854775805} -test expr-36.55 {expr edge cases} { +test expr-36.55 {expr edge cases} {wideIs64bit} { expr {$max / ($min + 1)} } {-1} -test expr-36.56 {expr edge cases} { +test expr-36.56 {expr edge cases} {wideIs64bit} { expr {$max % ($min + 1)} } {0} -test expr-36.57 {expr edge cases} { +test expr-36.57 {expr edge cases} {wideIs64bit} { expr {$max / $min} } {-1} -test expr-36.58 {expr edge cases} { +test expr-36.58 {expr edge cases} {wideIs64bit} { expr {$max % $min} } {-1} -test expr-36.59 {expr edge cases} { +test expr-36.59 {expr edge cases} {wideIs64bit} { expr {($min + 1) / ($max - 1)} } {-2} -test expr-36.60 {expr edge cases} { +test expr-36.60 {expr edge cases} {wideIs64bit} { expr {($min + 1) % ($max - 1)} } {9223372036854775805} -test expr-36.61 {expr edge cases} { +test expr-36.61 {expr edge cases} {wideIs64bit} { expr {($max - 1) / ($min + 1)} } {-1} -test expr-36.62 {expr edge cases} { +test expr-36.62 {expr edge cases} {wideIs64bit} { expr {($max - 1) % ($min + 1)} } {-1} -test expr-36.63 {expr edge cases} { +test expr-36.63 {expr edge cases} {wideIs64bit} { expr {($max - 1) / $min} } {-1} -test expr-36.64 {expr edge cases} { +test expr-36.64 {expr edge cases} {wideIs64bit} { expr {($max - 1) % $min} } {-2} -test expr-36.65 {expr edge cases} { +test expr-36.65 {expr edge cases} {wideIs64bit} { expr {($max - 2) / $min} } {-1} -test expr-36.66 {expr edge cases} { +test expr-36.66 {expr edge cases} {wideIs64bit} { expr {($max - 2) % $min} } {-3} -test expr-36.67 {expr edge cases} { +test expr-36.67 {expr edge cases} {wideIs64bit} { expr {($max - 3) / $min} } {-1} -test expr-36.68 {expr edge cases} { +test expr-36.68 {expr edge cases} {wideIs64bit} { expr {($max - 3) % $min} } {-4} -test expr-36.69 {expr edge cases} { +test expr-36.69 {expr edge cases} {wideIs64bit} { expr {-3 / $min} } {0} -test expr-36.70 {expr edge cases} { +test expr-36.70 {expr edge cases} {wideIs64bit} { expr {-3 % $min} } {-3} -test expr-36.71 {expr edge cases} { +test expr-36.71 {expr edge cases} {wideIs64bit} { expr {-2 / $min} } {0} -test expr-36.72 {expr edge cases} { +test expr-36.72 {expr edge cases} {wideIs64bit} { expr {-2 % $min} } {-2} -test expr-36.73 {expr edge cases} { +test expr-36.73 {expr edge cases} {wideIs64bit} { expr {-1 / $min} } {0} -test expr-36.74 {expr edge cases} { +test expr-36.74 {expr edge cases} {wideIs64bit} { expr {-1 % $min} } {-1} -test expr-36.75 {expr edge cases} { +test expr-36.75 {expr edge cases} {wideIs64bit} { expr {0 / $min} } {0} -test expr-36.76 {expr edge cases} { +test expr-36.76 {expr edge cases} {wideIs64bit} { expr {0 % $min} } {0} -test expr-36.77 {expr edge cases} { +test expr-36.77 {expr edge cases} {wideIs64bit} { expr {0 / ($min + 1)} } {0} -test expr-36.78 {expr edge cases} { +test expr-36.78 {expr edge cases} {wideIs64bit} { expr {0 % ($min + 1)} } {0} -test expr-36.79 {expr edge cases} { +test expr-36.79 {expr edge cases} {wideIs64bit} { expr {1 / $min} } {-1} -test expr-36.80 {expr edge cases} { +test expr-36.80 {expr edge cases} {wideIs64bit} { expr {1 % $min} } {-9223372036854775807} -test expr-36.81 {expr edge cases} { +test expr-36.81 {expr edge cases} {wideIs64bit} { expr {1 / ($min + 1)} } {-1} -test expr-36.82 {expr edge cases} { +test expr-36.82 {expr edge cases} {wideIs64bit} { expr {1 % ($min + 1)} } {-9223372036854775806} -test expr-36.83 {expr edge cases} { +test expr-36.83 {expr edge cases} {wideIs64bit} { expr {2 / $min} } {-1} -test expr-36.84 {expr edge cases} { +test expr-36.84 {expr edge cases} {wideIs64bit} { expr {2 % $min} } {-9223372036854775806} -test expr-36.85 {expr edge cases} { +test expr-36.85 {expr edge cases} {wideIs64bit} { expr {2 / ($min + 1)} } {-1} -test expr-36.86 {expr edge cases} { +test expr-36.86 {expr edge cases} {wideIs64bit} { expr {2 % ($min + 1)} } {-9223372036854775805} -test expr-36.87 {expr edge cases} { +test expr-36.87 {expr edge cases} {wideIs64bit} { expr {3 / $min} } {-1} -test expr-36.88 {expr edge cases} { +test expr-36.88 {expr edge cases} {wideIs64bit} { expr {3 % $min} } {-9223372036854775805} -test expr-36.89 {expr edge cases} { +test expr-36.89 {expr edge cases} {wideIs64bit} { expr {3 / ($min + 1)} } {-1} -test expr-36.90 {expr edge cases} { +test expr-36.90 {expr edge cases} {wideIs64bit} { expr {3 % ($min + 1)} } {-9223372036854775804} -test expr-37.1 {expr edge cases} { +test expr-37.1 {expr edge cases} {wideIs64bit} { set dividend $max set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($divisor * $q) + $r}] } {4611686018427387903 * 2 + 1 = 9223372036854775807} -test expr-37.2 {expr edge cases} { +test expr-37.2 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {4611686018427387903 * 2 + 0 = 9223372036854775806} -test expr-37.3 {expr edge cases} { +test expr-37.3 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {4611686018427387902 * 2 + 1 = 9223372036854775805} -test expr-37.4 {expr edge cases} { +test expr-37.4 {expr edge cases} {wideIs64bit} { set dividend $max set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * 3 + 1 = 9223372036854775807} -test expr-37.5 {expr edge cases} { +test expr-37.5 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 1}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * 3 + 0 = 9223372036854775806} -test expr-37.6 {expr edge cases} { +test expr-37.6 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 2}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258601 * 3 + 2 = 9223372036854775805} -test expr-37.7 {expr edge cases} { +test expr-37.7 {expr edge cases} {wideIs64bit} { set dividend $min set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387904 * 2 + 0 = -9223372036854775808} -test expr-37.8 {expr edge cases} { +test expr-37.8 {expr edge cases} {wideIs64bit} { set dividend [expr {$min + 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387904 * 2 + 1 = -9223372036854775807} -test expr-37.9 {expr edge cases} { +test expr-37.9 {expr edge cases} {wideIs64bit} { set dividend [expr {$min + 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387903 * 2 + 0 = -9223372036854775806} -test expr-37.10 {expr edge cases} { +test expr-37.10 {expr edge cases} {wideIs64bit} { # Multiplication overflows 64 bit type here, # so when the 1 is added it overflows # again and we end up back at min. @@ -6609,28 +6615,28 @@ test expr-37.10 {expr edge cases} { set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-3074457345618258603 * 3 + 1 = -9223372036854775808} -test expr-37.11 {expr edge cases} { +test expr-37.11 {expr edge cases} {wideIs64bit} { set dividend $min set divisor -3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * -3 + -2 = -9223372036854775808} -test expr-37.12 {expr edge cases} { +test expr-37.12 {expr edge cases} {wideIs64bit} { set dividend $min set divisor $min set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775808 + 0 = -9223372036854775808} -test expr-37.13 {expr edge cases} { +test expr-37.13 {expr edge cases} {wideIs64bit} { set dividend $min set divisor [expr {$min + 1}] set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775807 + -1 = -9223372036854775808} -test expr-37.14 {expr edge cases} { +test expr-37.14 {expr edge cases} {wideIs64bit} { set dividend $min set divisor [expr {$min + 2}] set q [expr {$dividend / $divisor}] @@ -6638,7 +6644,7 @@ test expr-37.14 {expr edge cases} { list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775806 + -2 = -9223372036854775808} -test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} { +test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { expr {abs(-2147483648)} } 2147483648 test expr-38.2 {abs and -0 [Bug 1893815]} { diff --git a/tests/format.test b/tests/format.test index ff85cb2..cdea545 100644 --- a/tests/format.test +++ b/tests/format.test @@ -18,6 +18,9 @@ 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 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} { @@ -544,13 +547,13 @@ for {set i 290} {$i < 400} {incr i} { append b "x" } -test format-17.1 {testing %d with wide} { +test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} { format %d 7810179016327718216 -} 7810179016327718216 -test format-17.2 {testing %ld with wide} { +} 1819043144 +test format-17.2 {testing %ld with wide} {wideIs64bit} { format %ld 7810179016327718216 } 7810179016327718216 -test format-17.3 {testing %ld with non-wide} { +test format-17.3 {testing %ld with non-wide} {wideIs64bit} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { @@ -577,11 +580,11 @@ 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} { +test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] -} {aaaaaaaaab 1} +} {aaaaaaab 1} test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body { set x 0x8fedc654 diff --git a/tests/obj.test b/tests/obj.test index 41b1428..ffd1a59 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -20,6 +20,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { 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 @@ -547,34 +549,34 @@ test obj-32.1 {freeing very large object trees} { unset x } {} -test obj-33.1 {integer overflow on input} { +test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} -test obj-33.2 {integer overflow on input} { +test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} test obj-33.3 {integer overflow on input} { - set x 0x10000; append x 0000 - list [string is integer $x] [expr { wide($x) }] -} {1 4294967296} -test obj-33.4 {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} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} -test obj-33.5 {integer overflow on input} { +test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} -test obj-33.6 {integer overflow on input} { +test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} { 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 -0x10000; append x 0000 - list [string is integer $x] [expr { wide($x) }] -} {1 -4294967296} + set x -0x100000000; append x 00000000 + list [string is integer $x] [expr { $x }] +} {0 -18446744073709551616} test obj-34.1 {mp_iseven} testobj { set result "" diff --git a/tests/scan.test b/tests/scan.test index 0b7b14a..1f32b9f 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -85,6 +85,8 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] +testConstraint wideIs64bit \ + [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x @@ -519,7 +521,7 @@ test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} -test scan-5.12 {integer scanning} -setup { +test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup { set a {}; set b {}; set c {} } -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ -- cgit v0.12 From b3fc99501ec94bdc4c05736825c08a050cf8046d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 19 Aug 2018 09:13:16 +0000 Subject: Still WIP. All test-cases pass now in 32-bit --- generic/tclInt.h | 7 ++-- generic/tclScan.c | 27 ++++----------- generic/tclStringObj.c | 91 +++++++++++--------------------------------------- tests/get.test | 12 +++---- tests/platform.test | 2 +- 5 files changed, 38 insertions(+), 101 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index c1e24f5..3fb042e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2705,8 +2705,11 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_NUMBER_LONG 1 -#define TCL_NUMBER_WIDE 2 +#define TCL_NUMBER_INT 2 +#if TCL_MAJOR_VERSION < 9 +# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */ +# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */ +#endif #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 diff --git a/generic/tclScan.c b/generic/tclScan.c index 0e3da17..458dbd8 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -571,11 +571,10 @@ Tcl_ScanObjCmd( const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; - long value; + Tcl_WideInt 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; @@ -924,21 +923,7 @@ Tcl_ScanObjCmd( Tcl_DecrRefCount(objPtr); break; } - if (flags & SCAN_LONGER) { - if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { - wideValue = LLONG_MAX; - if (TclGetString(objPtr)[0] == '-') { - wideValue = LLONG_MIN; - } - } - 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_BIG) { if (flags & SCAN_UNSIGNED) { mp_int big; int code = Tcl_GetBignumFromObj(interp, objPtr, &big); @@ -963,15 +948,15 @@ Tcl_ScanObjCmd( } } } else { - if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { - value = LONG_MIN; + value = LLONG_MIN; } else { - value = LONG_MAX; + value = LLONG_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ + sprintf(buf, "%" TCL_LL_MODIFIER "u", value); /* INTL: ISO digit */ Tcl_SetStringObj(objPtr, buf, -1); } else { TclSetIntObj(objPtr, value); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c103bea..9eaabea 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1817,9 +1817,6 @@ 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); @@ -2010,18 +2007,11 @@ 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); @@ -2091,16 +2081,10 @@ 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) { @@ -2119,53 +2103,32 @@ Tcl_AppendFormatToObj( ch = 'd'; } } -#ifndef TCL_WIDE_INT_IS_LONG - } else if (useWide) { - if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { - Tcl_Obj *objPtr; + } else 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(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); + 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); + TclGetWideIntFromObj(NULL, objPtr, &w); + Tcl_DecrRefCount(objPtr); if (useShort) { - s = (short) l; + s = (short) w; isNegative = (s < (short) 0); if (s == (short) 0) gotHash = 0; } else { - isNegative = (l < (long) 0); - if (l == (long) 0) gotHash = 0; + isNegative = (w < (long) 0); + if (w == (long) 0) gotHash = 0; } } else if (useShort) { - s = (short) l; + s = (short) w; isNegative = (s < (short) 0); if (s == (short) 0) gotHash = 0; } else { - isNegative = (l < (long) 0); - if (l == (long) 0) gotHash = 0; + isNegative = (w < (Tcl_WideInt) 0); + if (w == (Tcl_WideInt) 0) gotHash = 0; } segment = Tcl_NewObj(); @@ -2214,14 +2177,10 @@ 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_NewLongObj(l); + pure = Tcl_NewWideIntObj(w); } Tcl_IncrRefCount(pure); bytes = TclGetStringFromObj(pure, &length); @@ -2301,16 +2260,6 @@ 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); @@ -2327,12 +2276,12 @@ Tcl_AppendFormatToObj( goto errorMsg; } } else if (!useBig) { - unsigned long ul = (unsigned long) l; + Tcl_WideUInt uw = (Tcl_WideUInt) w; - bits = (Tcl_WideUInt) ul; - while (ul) { + bits = (Tcl_WideUInt) uw; + while (uw) { numDigits++; - ul /= base; + uw /= base; } } diff --git a/tests/get.test b/tests/get.test index d6a7206..b02b686 100644 --- a/tests/get.test +++ b/tests/get.test @@ -45,14 +45,14 @@ test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} { 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} + 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 longIs64bit} { - list [catch {testgetint +18446744073709551614} msg] $msg -} {0 -2} + 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 longIs64bit} { - list [catch {testgetint -18446744073709551614} msg] $msg -} {0 2} + 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 longIs32bit} { list [catch {testgetint 44 4294967296} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} diff --git a/tests/platform.test b/tests/platform.test index fa533e8..83848e8 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -43,7 +43,7 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { # everything these days. Note that this does *not* use wide(), and # this is intentional since that could make Tcl's numbers wider than # the machine-integer on some platforms... -test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { +test platform-2.1 {tcl_platform(wordSize) indicates size of native word} nonPortable { set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}] # Result must be the largest bit in a machine word, which this checks # without assuming how wide the word really is -- cgit v0.12 From 80d62f05475d6f7a0b3093a0ee583905d3b390c9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Aug 2018 21:36:03 +0000 Subject: improved reange checking (also for the Tcl 9.0 proposal). Make platform test platform 32/64-bit independant --- generic/tclBasic.c | 2 +- generic/tclInt.h | 4 ++-- generic/tclObj.c | 41 ++++++++++++++++++++++++++++++----------- generic/tclTest.c | 22 ++++++++++++++++++++++ tests/platform.test | 14 ++++---------- 5 files changed, 59 insertions(+), 24 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 699975e..0769f24 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -116,6 +116,7 @@ static Tcl_ObjCmdProc ExprCeilFunc; static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprEntierFunc; static Tcl_ObjCmdProc ExprFloorFunc; +static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; @@ -124,7 +125,6 @@ static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; -static Tcl_ObjCmdProc ExprIntFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; diff --git a/generic/tclInt.h b/generic/tclInt.h index 038fa88..928d649 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2498,7 +2498,7 @@ typedef struct List { #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ - && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX)) \ + && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif @@ -2506,7 +2506,7 @@ typedef struct List { #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ - && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \ + && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ diff --git a/generic/tclObj.c b/generic/tclObj.c index b1e4b29..3bbe7b6 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2516,7 +2516,14 @@ Tcl_GetIntFromObj( if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) { return TCL_ERROR; } - if ((ULONG_MAX > UINT_MAX) && ((l > (long)(UINT_MAX)) || (l < (long)(INT_MIN)))) { + if ( +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + (l > (long)(UINT_MAX)) +#else + (l > (long)(INT_MAX)) +#endif + || (l < (long)(INT_MIN)) + ) { if (interp != NULL) { const char *s = "integer value too large to represent as non-long integer"; @@ -2805,8 +2812,13 @@ Tcl_GetLongFromObj( Tcl_WideInt w = objPtr->internalRep.wideValue; - if (w >= (Tcl_WideInt)(LONG_MIN) - && w <= (Tcl_WideInt)(ULONG_MAX)) { + if ( +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + w <= (Tcl_WideInt)(ULONG_MAX)) { +#else + w <= (Tcl_WideInt)(LONG_MAX)) { +#endif + && w >= (Tcl_WideInt)(LONG_MIN) *longPtr = Tcl_WideAsLong(w); return TCL_OK; } @@ -2833,22 +2845,29 @@ Tcl_GetLongFromObj( mp_int big; UNPACK_BIGNUM(objPtr, big); - if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) + if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1) / DIGIT_BIT) { - unsigned long value = 0, numBytes = sizeof(long); - long scratch; + unsigned long scratch, value = 0, numBytes = sizeof(unsigned long); unsigned char *bytes = (unsigned char *) &scratch; if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } - if (big.sign) { - *longPtr = - (long) value; - } else { - *longPtr = (long) value; + if ( +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 8 + big.sign ? (value <= 1 + (unsigned long)LONG_MAX) : (value <= (unsigned long)ULONG_MAX) +#else + big.sign ? (value <= 1 + (unsigned long)LONG_MAX) : (value <= (unsigned long)LONG_MAX) +#endif + ) { + if (big.sign) { + *longPtr = - (long) value; + } else { + *longPtr = (long) value; + } + return TCL_OK; } - return TCL_OK; } } #ifndef TCL_WIDE_INT_IS_LONG diff --git a/generic/tclTest.c b/generic/tclTest.c index ac01ecf..48b4761 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -293,6 +293,8 @@ static int TestgetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestgetintCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); +static int TestlongsizeCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); static int TestgetplatformCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestgetvarfullnameCmd( @@ -645,6 +647,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd, + NULL, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetvarfullname", @@ -6936,6 +6940,24 @@ TestgetintCmd( } } +/* + * Used for determining sizeof(long) at script level. + */ +static int +TestlongsizeCmd( + ClientData dummy, + Tcl_Interp *interp, + int argc, + const char **argv) +{ + if (argc != 1) { + Tcl_AppendResult(interp, "wrong # args", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long))); + return TCL_OK; +} + static int NREUnwind_callback( ClientData data[], diff --git a/tests/platform.test b/tests/platform.test index 83848e8..5880fb9 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -25,6 +25,7 @@ namespace eval ::tcl::test::platform { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testCPUID [llength [info commands testcpuid]] +testConstraint testlongsize [llength [info commands testlongsize]] test platform-1.0 {tcl_platform(engine)} { set tcl_platform(engine) @@ -39,16 +40,9 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { set result } {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize} -# Test assumes twos-complement arithmetic, which is true of virtually -# everything these days. Note that this does *not* use wide(), and -# this is intentional since that could make Tcl's numbers wider than -# the machine-integer on some platforms... -test platform-2.1 {tcl_platform(wordSize) indicates size of native word} nonPortable { - set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}] - # Result must be the largest bit in a machine word, which this checks - # without assuming how wide the word really is - list [expr {$result < 0}] [expr {$result ^ int($result - 1)}] -} {1 -1} +test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize { + expr {$tcl_platform(wordSize) == [testlongsize]} +} {1} # On Windows/UNIX, test that the CPU ID works -- cgit v0.12 From eeebae7172a523bec78bf30c81cccc2947918d96 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 28 Aug 2018 22:28:50 +0000 Subject: Now, restore wide(), but make int() the same as entier(). Add new utility function. --- generic/tclBasic.c | 60 +++++++++++--------------------- generic/tclBinary.c | 35 +++++++++---------- generic/tclCmdMZ.c | 2 +- generic/tclCompCmdsSZ.c | 2 +- generic/tclInt.h | 2 ++ generic/tclObj.c | 68 ++++++++++++++++++++++++++++++++++++ generic/tclScan.c | 24 +++++++++---- generic/tclStringObj.c | 91 ++++++++++++++++++++++++++++++++++++++----------- tests/compExpr-old.test | 6 ++-- tests/expr-old.test | 4 +-- tests/expr.test | 6 ++-- tests/format.test | 9 +++-- tests/get.test | 4 +-- tests/obj.test | 17 +++++---- tests/scan.test | 15 ++++---- 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 -- cgit v0.12 From c8e7bb76530d11a14efed5988023df2341f51595 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Aug 2018 19:30:37 +0000 Subject: Fix compilation on 32-bit platforms, and fix unit-tests in this environment --- generic/tclObj.c | 6 +++--- tests/compExpr-old.test | 9 +++------ tests/expr.test | 35 ++++++++++++++++------------------- tests/get.test | 2 +- 4 files changed, 23 insertions(+), 29 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 75f9cb7..d9d9ca9 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2814,11 +2814,11 @@ Tcl_GetLongFromObj( if ( #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - w <= (Tcl_WideInt)(ULONG_MAX)) { + (w <= (Tcl_WideInt)(ULONG_MAX)) #else - w <= (Tcl_WideInt)(LONG_MAX)) { + (w <= (Tcl_WideInt)(LONG_MAX)) #endif - && w >= (Tcl_WideInt)(LONG_MIN) + && (w >= (Tcl_WideInt)(LONG_MIN))) { *longPtr = Tcl_WideAsLong(w); return TCL_OK; } diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 9dfe4c4..c80810c 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -332,15 +332,12 @@ test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1 test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 -# The following test is different for 32-bit versus 64-bit -# architectures because LONG_MIN is different +# The following test is no longer different for 32-bit versus 64-bit +# architectures -test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { +test compExpr-old-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} { expr {int(1<<63)} } 9223372036854775808 -test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { - expr {int(1<<31)} -} -2147483648 test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 diff --git a/tests/expr.test b/tests/expr.test index 913df1b..3784fa8 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -417,12 +417,9 @@ test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 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 { +test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} { expr {int(1<<63)} } 9223372036854775808 -test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { - expr {int(1<<31)} -} -2147483648 test expr-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 } -returnCodes error -match glob -result * @@ -1405,8 +1402,8 @@ test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0 test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0 test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0 test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0 -test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0 -test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0 +test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480 +test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040 test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480 test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0 @@ -5809,7 +5806,7 @@ test expr-32.9 {bignum regression} { expr {0%-(1+(1<<63))} } 0 -test expr-33.1 {parse largest long value} longIs32bit { +test expr-33.1 {parse largest long value} { set max_long_str 2147483647 set max_long_hex "0x7FFFFFFF " @@ -5823,7 +5820,7 @@ test expr-33.1 {parse largest long value} longIs32bit { [expr {$max_long + 0}] \ [expr {2147483647 + 0}] \ [expr {$max_long == $max_long_hex}] \ - [expr {int(2147483647 + 1) < 0}] \ + [expr {int(2147483647 + 1) > 0}] \ } {2147483647 2147483647 2147483647 2147483647 1 1} test expr-33.2 {parse smallest long value} longIs32bit { @@ -5843,7 +5840,7 @@ test expr-33.2 {parse smallest long value} longIs32bit { [expr {$min_long + 0}] \ [expr {-2147483648 + 0}] \ [expr {$min_long == $min_long_hex}] \ - [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \ + [expr {int(-2147483648 - 1) == -0x80000001}] \ } {-2147483648 -2147483648 -2147483648 -2147483648 1 1} test expr-33.3 {parse largest wide value} wideIs64bit { @@ -5923,17 +5920,17 @@ test expr-34.11 {expr edge cases} { test expr-34.12 {expr edge cases} { expr {$min % -2} } {0} -test expr-34.13 {expr edge cases} longIs32bit { +test expr-34.13 {expr edge cases} { expr {int($min / -1)} -} {-2147483648} +} {2147483648} test expr-34.14 {expr edge cases} { expr {$min % -1} } {0} -test expr-34.15 {expr edge cases} longIs32bit { - expr {int($min * -1)} +test expr-34.15 {expr edge cases} { + expr {-int($min * -1)} } $min -test expr-34.16 {expr edge cases} longIs32bit { - expr {int(-$min)} +test expr-34.16 {expr edge cases} { + expr {-int(-$min)} } $min test expr-34.17 {expr edge cases} { expr {$min / 1} @@ -6720,8 +6717,8 @@ test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj { testexprlongobj -0x80000000 } {This is a result: -2147483648} test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { - testexprlongobj -0xffffffff -} {This is a result: 1} + testexprlongobj -0x7fffffff +} {This is a result: -2147483647} test expr-39.10 {Tcl_ExprLongObj handles overflows} \ -constraints {testexprlongobj longIs32bit} \ -match glob \ @@ -6746,8 +6743,8 @@ test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj { testexprlongobj -2147483648. } {This is a result: -2147483648} test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { - testexprlongobj -4294967295. -} {This is a result: 1} + testexprlongobj -2147483648. +} {This is a result: -2147483648} test expr-39.16 {Tcl_ExprLongObj handles overflows} \ -constraints {testexprlongobj longIs32bit} \ -match glob \ diff --git a/tests/get.test b/tests/get.test index f85bc01..3207d5f 100644 --- a/tests/get.test +++ b/tests/get.test @@ -64,7 +64,7 @@ test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} { } {0 -2} test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} { list [catch {testgetint -4294967294} msg] $msg -} {0 2} +} {1 {integer value too large to represent}} test get-2.1 {Tcl_GetInt procedure} { format %g 1.23 -- cgit v0.12 From 33201eb14cf67e9484e1a711ecda15264dd48d4c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 8 Sep 2018 21:34:48 +0000 Subject: Bring back test-cases closer to what they were --- tests/scan.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/scan.test b/tests/scan.test index 689a6ba..b488f68 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} { # procedure that returns the range of integers proc int_range {} { - set MAX_INT [expr {[format %lu -2]/2}] + set MAX_INT [expr {[format %u -2]/2}] set MIN_INT [expr { ~ $MAX_INT }] return [list $MIN_INT $MAX_INT] } @@ -442,14 +442,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 {%lo %lo %lo} -1 $MIN_INT $MAX_INT] - list [scan $scanstring {%lo %lo %lo} a b c] \ + set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT] + list [scan $scanstring {%o %o %o} 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 {%lx %lx %lx} -1 $MIN_INT $MAX_INT] - list [scan $scanstring {%lx %lx %lx} a b c] \ + set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT] + list [scan $scanstring {%x %x %x} 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} { -- cgit v0.12 From b47bd89d441fcfb77be42ca7c4921b9a241d1c8b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 8 Sep 2018 21:49:09 +0000 Subject: TCL_NUMBER_WIDE -> TCL_NUMBER_INT. Two test-cases still failing --- generic/tclBasic.c | 4 +-- generic/tclExecute.c | 70 ++++++++++++++++++++++++++-------------------------- generic/tclInt.h | 2 +- generic/tclObj.c | 2 +- 4 files changed, 39 insertions(+), 39 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7294dd6..390df8f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6519,7 +6519,7 @@ Tcl_ExprLongObj( resultPtr = Tcl_NewBignumObj(&big); /* FALLTHROUGH */ } - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: case TCL_NUMBER_BIG: result = TclGetLongFromObj(interp, resultPtr, ptr); break; @@ -7495,7 +7495,7 @@ ExprAbsFunc( return TCL_ERROR; } - if (type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_INT) { Tcl_WideInt l = *((const Tcl_WideInt *) ptr); if (l > (Tcl_WideInt)0) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 034bfd2..a82cf2e 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -500,7 +500,7 @@ VarHashCreateVar( #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ - ? (*(tPtr) = TCL_NUMBER_WIDE, \ + ? (*(tPtr) = TCL_NUMBER_INT, \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclDoubleType) \ @@ -3620,7 +3620,7 @@ TEBCresume( objPtr = varPtr->value.objPtr; if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { - if (type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_INT) { Tcl_WideInt augend = *((const Tcl_WideInt *)ptr); Tcl_WideInt sum = augend + increment; @@ -3662,7 +3662,7 @@ TEBCresume( TclSetIntObj(objPtr, w+increment); } goto doneIncr; - } /* end if (type == TCL_NUMBER_WIDE) */ + } /* end if (type == TCL_NUMBER_INT) */ } if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ @@ -5640,7 +5640,7 @@ TEBCresume( Tcl_WideInt w; if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { - type1 = TCL_NUMBER_WIDE; + type1 = TCL_NUMBER_INT; } } TclNewIntObj(objResultPtr, type1); @@ -5686,7 +5686,7 @@ TEBCresume( compare = MP_EQ; goto convertComparison; } - if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) { w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); @@ -5765,7 +5765,7 @@ TEBCresume( * Check for common, simple case. */ - if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) { w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); @@ -6005,7 +6005,7 @@ TEBCresume( * an external function. */ - if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) { w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); @@ -6148,7 +6148,7 @@ TEBCresume( CACHE_STACK_INFO(); goto gotError; } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *) ptr1); if (Tcl_IsShared(valuePtr)) { TclNewIntObj(objResultPtr, ~w1); @@ -6185,7 +6185,7 @@ TEBCresume( /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != LLONG_MIN) { if (Tcl_IsShared(valuePtr)) { @@ -7864,7 +7864,7 @@ ExecuteExtendedBinaryMathOp( /* TODO: Attempts to re-use unshared operands on stack */ w2 = 0; /* silence gcc warning */ - if (type2 == TCL_NUMBER_WIDE) { + if (type2 == TCL_NUMBER_INT) { w2 = *((const Tcl_WideInt *)ptr2); if (w2 == 0) { return DIVIDED_BY_ZERO; @@ -7877,7 +7877,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *)ptr1); if (w1 == 0) { @@ -7955,7 +7955,7 @@ ExecuteExtendedBinaryMathOp( */ switch (type2) { - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; case TCL_NUMBER_BIG: @@ -7977,7 +7977,7 @@ ExecuteExtendedBinaryMathOp( * Zero shifted any number of bits is still zero. */ - if ((type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) { + if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) { return constants[0]; } @@ -7990,7 +7990,7 @@ ExecuteExtendedBinaryMathOp( * counterparts, leading to incorrect results. */ - if ((type2 != TCL_NUMBER_WIDE) + if ((type2 != TCL_NUMBER_INT) || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) in @@ -8023,7 +8023,7 @@ ExecuteExtendedBinaryMathOp( * Quickly force large right shifts to 0 or -1. */ - if ((type2 != TCL_NUMBER_WIDE) + if ((type2 != TCL_NUMBER_INT) || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) { /* * Again, technically, the value to be shifted could be an @@ -8034,7 +8034,7 @@ ExecuteExtendedBinaryMathOp( */ switch (type1) { - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; case TCL_NUMBER_BIG: @@ -8057,7 +8057,7 @@ ExecuteExtendedBinaryMathOp( * Handle shifts within the native wide range. */ - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *(const Tcl_WideInt *)ptr1; if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) { if (w1 >= (Tcl_WideInt)0) { @@ -8234,7 +8234,7 @@ ExecuteExtendedBinaryMathOp( BIG_RESULT(&bigResult); } - if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -8288,7 +8288,7 @@ ExecuteExtendedBinaryMathOp( goto doubleResult; } w2 = 0; - if (type2 == TCL_NUMBER_WIDE) { + if (type2 == TCL_NUMBER_INT) { w2 = *((const Tcl_WideInt *) ptr2); if (w2 == 0) { /* @@ -8306,7 +8306,7 @@ ExecuteExtendedBinaryMathOp( } switch (type2) { - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: w2 = *((const Tcl_WideInt *)ptr2); negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); @@ -8320,11 +8320,11 @@ ExecuteExtendedBinaryMathOp( break; } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *)ptr1); } if (negativeExponent) { - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { switch (w1) { case 0: /* @@ -8354,7 +8354,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { switch (w1) { case 0: /* @@ -8381,17 +8381,17 @@ ExecuteExtendedBinaryMathOp( * which means the max exponent value is 2**28-1 = 0x0fffffff = * 268435455, which fits into a signed 32 bit int which is within the * range of the long int type. This means any numeric Tcl_Obj value - * not using TCL_NUMBER_WIDE type must hold a value larger than we + * not using TCL_NUMBER_INT type must hold a value larger than we * accept. */ - if (type2 != TCL_NUMBER_WIDE) { + if (type2 != TCL_NUMBER_INT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { if (w1 == 2) { /* * Reduce small powers of 2 to shifts. @@ -8415,7 +8415,7 @@ ExecuteExtendedBinaryMathOp( goto overflowExpon; } } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *) ptr1); } else { goto overflowExpon; @@ -8615,7 +8615,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = w1 + w2; - if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) + if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) { /* * Check for overflow. @@ -8629,7 +8629,7 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = w1 - w2; - if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) + if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) { /* * Must check for overflow. The macro tests for overflows @@ -8752,7 +8752,7 @@ ExecuteExtendedUnaryMathOp( switch (opcode) { case INST_BITNOT: - if (type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_INT) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } @@ -8765,7 +8765,7 @@ ExecuteExtendedUnaryMathOp( switch (type) { case TCL_NUMBER_DOUBLE: DOUBLE_RESULT(-(*((const double *) ptr))); - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: w = *((const Tcl_WideInt *) ptr); if (w != LLONG_MIN) { WIDE_RESULT(-w); @@ -8819,10 +8819,10 @@ TclCompareTwoNumbers( (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (type1) { - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *)ptr1); switch (type2) { - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: w2 = *((const Tcl_WideInt *)ptr2); wideCompare: return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); @@ -8879,7 +8879,7 @@ TclCompareTwoNumbers( d2 = *((const double *)ptr2); doubleCompare: return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) @@ -8921,7 +8921,7 @@ TclCompareTwoNumbers( case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { - case TCL_NUMBER_WIDE: + case TCL_NUMBER_INT: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); return compare; diff --git a/generic/tclInt.h b/generic/tclInt.h index 1ed4f37..b08d86c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2710,7 +2710,7 @@ typedef struct ProcessGlobalValue { */ #define TCL_NUMBER_INT 2 -#if TCL_MAJOR_VERSION < 9 +#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED) # define TCL_NUMBER_LONG 1 /* deprecated, not used any more */ # define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */ #endif diff --git a/generic/tclObj.c b/generic/tclObj.c index 59f3090..aafb045 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3639,7 +3639,7 @@ TclGetNumberFromObj( return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - *typePtr = TCL_NUMBER_WIDE; + *typePtr = TCL_NUMBER_INT; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } -- cgit v0.12