summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-08 19:36:29 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-08 19:36:29 (GMT)
commitdf93fd85a35f40f47d2d6b9a7ec9326346b3b6b4 (patch)
tree6744c6bef5b033702c89aa10637679f26083fa6d
parent1812305cb35d0096d50f9b1e7c1c368f230b6f07 (diff)
parente7a40e1084f2d3c711a2aeccccb9b9b40b0c37e7 (diff)
downloadtcl-df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4.zip
tcl-df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4.tar.gz
tcl-df93fd85a35f40f47d2d6b9a7ec9326346b3b6b4.tar.bz2
Merge 8.7
-rw-r--r--generic/tclBasic.c30
-rw-r--r--generic/tclCmdMZ.c5
-rw-r--r--generic/tclCompCmdsSZ.c5
-rw-r--r--generic/tclExecute.c81
-rw-r--r--generic/tclInt.h15
-rw-r--r--generic/tclObj.c30
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--tests/compExpr-old.test11
-rw-r--r--tests/execute.test14
-rw-r--r--tests/expr-old.test18
-rw-r--r--tests/expr.test37
-rw-r--r--tests/get.test14
-rw-r--r--tests/obj.test4
-rw-r--r--tests/scan.test7
-rw-r--r--tests/string.test30
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