diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-10-08 19:36:29 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-10-08 19:36:29 (GMT) |
| commit | df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4 (patch) | |
| tree | 6744c6bef5b033702c89aa10637679f26083fa6d | |
| parent | 1812305cb35d0096d50f9b1e7c1c368f230b6f07 (diff) | |
| parent | e7a40e1084f2d3c711a2aeccccb9b9b40b0c37e7 (diff) | |
| download | tcl-df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4.zip tcl-df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4.tar.gz tcl-df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4.tar.bz2 | |
Merge 8.7
| -rw-r--r-- | generic/tclBasic.c | 30 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 5 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 5 | ||||
| -rw-r--r-- | generic/tclExecute.c | 81 | ||||
| -rw-r--r-- | generic/tclInt.h | 15 | ||||
| -rw-r--r-- | generic/tclObj.c | 30 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 4 | ||||
| -rw-r--r-- | tests/compExpr-old.test | 11 | ||||
| -rw-r--r-- | tests/execute.test | 14 | ||||
| -rw-r--r-- | tests/expr-old.test | 18 | ||||
| -rw-r--r-- | tests/expr.test | 37 | ||||
| -rw-r--r-- | tests/get.test | 14 | ||||
| -rw-r--r-- | tests/obj.test | 4 | ||||
| -rw-r--r-- | tests/scan.test | 7 | ||||
| -rw-r--r-- | tests/string.test | 30 |
15 files changed, 136 insertions, 169 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 2908ba1..fbff5a0 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; @@ -390,7 +389,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 }, @@ -6201,7 +6200,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; @@ -7024,7 +7023,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) { @@ -7145,7 +7144,7 @@ ExprDoubleFunc( } static int -ExprEntierFunc( +ExprIntFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ @@ -7201,25 +7200,6 @@ ExprEntierFunc( } static int -ExprIntFunc( - 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; - if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) { - return TCL_ERROR; - } - objPtr = Tcl_GetObjResult(interp); - TclGetWideBitsFromObj(NULL, objPtr, &wResult); - Tcl_SetObjResult(interp, Tcl_NewLongObj((long)wResult)); - return TCL_OK; -} - -static int ExprWideFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7229,7 +7209,7 @@ ExprWideFunc( { Tcl_WideInt wResult; - if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) { + if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) { return TCL_ERROR; } TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult); diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 0d89e3a..3fb5106 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1624,10 +1624,6 @@ StringIsCmd( 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)) { @@ -1675,7 +1671,6 @@ StringIsCmd( break; } - failedIntParse: string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 4041b5a..3b571b1 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -691,14 +691,11 @@ TclCompileStringIsCmd( } switch (t) { - case STR_IS_INT: - PUSH( "1"); - OP( EQ); - break; 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/tclExecute.c b/generic/tclExecute.c index 0b7e231..e6067c1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -442,7 +442,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) \ @@ -3477,7 +3477,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; @@ -3519,7 +3519,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 */ @@ -5424,22 +5424,13 @@ 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 WIDE_MIN and WIDE_MAX */ - /* [string is integer] is -UINT_MAX to UINT_MAX range */ - /* [string is wideinteger] is -UWIDE_MAX to UWIDE_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 WIDE_MIN to WIDE_MAX range */ - /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ + /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */ Tcl_WideInt w; if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { - type1 = TCL_NUMBER_WIDE; + type1 = TCL_NUMBER_INT; } } TclNewIntObj(objResultPtr, type1); @@ -5485,7 +5476,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); @@ -5564,7 +5555,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); @@ -5804,7 +5795,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); @@ -5947,7 +5938,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); @@ -5984,7 +5975,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 != WIDE_MIN) { if (Tcl_IsShared(valuePtr)) { @@ -7501,7 +7492,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; @@ -7514,7 +7505,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *)ptr1); if (w1 == 0) { @@ -7592,7 +7583,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: @@ -7614,7 +7605,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]; } @@ -7627,7 +7618,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 @@ -7660,7 +7651,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 @@ -7671,7 +7662,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: @@ -7694,7 +7685,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) { @@ -7871,7 +7862,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); @@ -7925,7 +7916,7 @@ ExecuteExtendedBinaryMathOp( goto doubleResult; } w2 = 0; - if (type2 == TCL_NUMBER_WIDE) { + if (type2 == TCL_NUMBER_INT) { w2 = *((const Tcl_WideInt *) ptr2); if (w2 == 0) { /* @@ -7943,7 +7934,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); @@ -7957,11 +7948,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: /* @@ -7991,7 +7982,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { switch (w1) { case 0: /* @@ -8018,17 +8009,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. @@ -8052,7 +8043,7 @@ ExecuteExtendedBinaryMathOp( goto overflowExpon; } } - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *) ptr1); } else { goto overflowExpon; @@ -8252,7 +8243,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. @@ -8266,7 +8257,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 @@ -8389,7 +8380,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); } @@ -8402,7 +8393,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 != WIDE_MIN) { WIDE_RESULT(-w); @@ -8456,10 +8447,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); @@ -8516,7 +8507,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) @@ -8558,7 +8549,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 cb833d1..53e40ab 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2432,16 +2432,16 @@ typedef struct List { #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType \ - && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \ - && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX)) \ + && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ + && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType \ - && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \ - && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \ + && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ + && (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) \ @@ -2644,8 +2644,11 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_NUMBER_LONG 1 -#define TCL_NUMBER_WIDE 2 +#define TCL_NUMBER_INT 2 +#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 #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 diff --git a/generic/tclObj.c b/generic/tclObj.c index e2c17b6..4266aba 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2252,7 +2252,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 > UINT_MAX) || (l < INT_MIN))) { if (interp != NULL) { const char *s = "integer value too large to represent as non-long integer"; @@ -2360,7 +2360,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 @@ -2369,7 +2369,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 = (long) w; return TCL_OK; @@ -2407,11 +2407,16 @@ Tcl_GetLongFromObj( value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { - *longPtr = - (long) value; + if (value <= 1 + (unsigned long)LONG_MAX) { + *longPtr = - (long) value; + return TCL_OK; + } } else { - *longPtr = (long) value; + if (value <= (unsigned long)ULONG_MAX) { + *longPtr = (long) value; + return TCL_OK; + } } - return TCL_OK; } } #ifndef TCL_WIDE_INT_IS_LONG @@ -2646,11 +2651,16 @@ Tcl_GetWideIntFromObj( value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { - *wideIntPtr = - (Tcl_WideInt) value; + if (value <= -(Tcl_WideUInt)WIDE_MIN) { + *wideIntPtr = - (Tcl_WideInt) value; + return TCL_OK; + } } else { - *wideIntPtr = (Tcl_WideInt) value; + if (value <= (Tcl_WideUInt)WIDE_MAX) { + *wideIntPtr = (Tcl_WideInt) value; + return TCL_OK; + } } - return TCL_OK; } } if (interp != NULL) { @@ -3190,7 +3200,7 @@ TclGetNumberFromObj( return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - *typePtr = TCL_NUMBER_WIDE; + *typePtr = TCL_NUMBER_INT; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 79cd2be..dc1dc07 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -149,7 +149,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 { @@ -165,7 +165,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 4c51721..62b9f5c 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -331,16 +331,9 @@ test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 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 - -test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { +test compExpr-old-9.5 {CompileRelationalExpr: large shift expr} { expr {int(1<<63)} -} -9223372036854775808 -test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { - expr {int(1<<31)} -} -2147483648 +} 9223372036854775808 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 13ac348..d4dbe5b 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -801,9 +801,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 {wide($x) < 0} } 1 test execute-7.9 {Wide int handling in INST_MOD} { expr {(wide(1)<<60) % ((wide(47)<<45)-1)} @@ -883,12 +883,12 @@ 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 { +test execute-7.32 {Wide int handling} { expr {int(1024 * 1024 * 1024 * 1024)} -} 0 -test execute-7.33 {Wide int handling} longIs32bit { +} 1099511627776 +test execute-7.33 {Wide int handling} { expr {int(0x1 * 1024 * 1024 * 1024 * 1024)} -} 0 +} 1099511627776 test execute-7.34 {Wide int handling} { expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} } 1099511627776 diff --git a/tests/expr-old.test b/tests/expr-old.test index 50040a5..9f9ad99 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -814,10 +814,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} @@ -1036,8 +1036,8 @@ test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong { testexprlong -0x80000000 } {This is a result: -2147483648} test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { - testexprlong -0xffffffff -} {This is a result: 1} + testexprlong -0x7fffffff +} {This is a result: -2147483647} test expr-old-37.10 {Tcl_ExprLong handles overflows} \ -constraints {testexprlong longIs32bit} \ -match glob \ @@ -1061,9 +1061,13 @@ test expr-old-37.13 {Tcl_ExprLong handles overflows} \ test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong { testexprlong -2147483648. } {This is a result: -2147483648} -test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { - testexprlong -4294967295. -} {This is a result: 1} +test expr-old-37.15 {Tcl_ExprLong handles overflows} \ + -constraints {testexprlong longIs32bit} \ + -match glob \ + -body { + list [catch {testexprlong -2147483649.} result] $result + } \ + -result {1 {integer value too large to represent*}} test expr-old-37.16 {Tcl_ExprLong handles overflows} \ -constraints {testexprlong longIs32bit} \ -match glob \ diff --git a/tests/expr.test b/tests/expr.test index 279115c..cc892f3 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -416,12 +416,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 +} 9223372036854775808 test expr-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 } -returnCodes error -match glob -result * @@ -1404,8 +1401,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 @@ -5808,7 +5805,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 " @@ -5822,7 +5819,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 { @@ -5842,7 +5839,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 { @@ -5922,17 +5919,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} @@ -6719,8 +6716,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 \ @@ -6745,8 +6742,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 9851925..997906a 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} + testgetint 18446744073709551614 +} {-2} test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} { - list [catch {testgetint +18446744073709551614} msg] $msg -} {0 -2} + testgetint +18446744073709551614 +} {-2} 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}}} @@ -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 diff --git a/tests/obj.test b/tests/obj.test index d407669..cd33eaa 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -560,7 +560,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} { test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] -} {0 4294967296} +} {1 4294967296} test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] @@ -576,7 +576,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} { 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 5c38fff..b488f68 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 %u -2]/2}] + set MIN_INT [expr { ~ $MAX_INT }] return [list $MIN_INT $MAX_INT] } diff --git a/tests/string.test b/tests/string.test index 8572545..79f25fc 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, 32-bit overflow} { +test string-6.92.$noComp {string is integer, no 64-bit overflow} { # Bug 718878 - set x 0x100000000 - list [run {string is integer -failindex var $x}] $var -} {0 -1} -test string-6.93.$noComp {string is integer, 32-bit overflow} { + set x 0x10000000000000000 + run {string is integer $x} +} 1 +test string-6.93.$noComp {string is integer, no 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} { + run {string is integer $x} +} 1 +test string-6.94.$noComp {string is integer, no 64-bit overflow} { # Bug 718878 - set x 0x100000000 - list [run {string is integer -failindex var [expr {$x}]}] $var -} {0 -1} + set x 0x10000000000000000 + run {string is integer [expr {$x}]} +} 1 test string-6.95.$noComp {string is wideinteger, true} { run {string is wideinteger +1234567890} } 1 |
