Tcl Source Code

Check-in [f22395629e]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Experiment, resolving platform differences at script level. Don't look ...
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | all-wideint
Files: files | file ages | folders
SHA3-256: f22395629e31bd5cfb761c1a39b17a059e3eec352b96603c6fa9c34855a95b56
User & Date: jan.nijtmans 2018-08-16 18:03:27
Context
2018-08-16
18:13
Few more test-cases check-in: 61da668e6f user: jan.nijtmans tags: all-wideint
18:03
Experiment, resolving platform differences at script level. Don't look ... check-in: f22395629e user: jan.nijtmans tags: all-wideint
2018-08-14
07:27
Merge 8.7. Also provide a new function for handling ByteArrays check-in: 2e99b95206 user: jan.nijtmans tags: tip-481
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
....
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
....
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
static Tcl_ObjCmdProc	ExprAbsFunc;
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;
static Tcl_ObjCmdProc	ExprMaxFunc;
static Tcl_ObjCmdProc	ExprMinFunc;
static Tcl_ObjCmdProc	ExprRandFunc;
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;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static Tcl_NRPostProc	NRCommand;

#if !defined(TCL_NO_DEPRECATED)
................................................................................
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	(ClientData) sin	},
    { "sinh",	ExprUnaryFunc,	(ClientData) sinh	},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	(ClientData) tan	},
    { "tanh",	ExprUnaryFunc,	(ClientData) tanh	},
    { "wide",	ExprWideFunc,	NULL			},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.
 */

................................................................................
	    args[k].type = TCL_DOUBLE;
	    /* FALLTHROUGH */

	case TCL_DOUBLE:
	    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) {
		ckfree(args);
		return TCL_ERROR;
	    }
	    valuePtr = Tcl_GetObjResult(interp);
	    TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
	    Tcl_ResetResult(interp);
	    break;
................................................................................

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

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. */
{
    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;






<








|







 







|







 







<
<
<
<
<
<
<
<

|







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







112
113
114
115
116
117
118

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
....
3655
3656
3657
3658
3659
3660
3661








3662
3663
3664
3665
3666
3667
3668
3669
3670
....
7661
7662
7663
7664
7665
7666
7667
































7668
7669
7670
7671
7672
7673
7674
static Tcl_ObjCmdProc	ExprAbsFunc;
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	ExprIsqrtFunc;
static Tcl_ObjCmdProc	ExprMaxFunc;
static Tcl_ObjCmdProc	ExprMinFunc;
static Tcl_ObjCmdProc	ExprRandFunc;
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;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static Tcl_NRPostProc	NRCommand;

#if !defined(TCL_NO_DEPRECATED)
................................................................................
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	(ClientData) sin	},
    { "sinh",	ExprUnaryFunc,	(ClientData) sinh	},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	(ClientData) tan	},
    { "tanh",	ExprUnaryFunc,	(ClientData) tanh	},
    { "wide",	ExprIntFunc,	NULL			},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.
 */

................................................................................
	    args[k].type = TCL_DOUBLE;
	    /* FALLTHROUGH */

	case TCL_DOUBLE:
	    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);
	    TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
	    Tcl_ResetResult(interp);
	    break;
................................................................................

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

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;

Changes to generic/tclCmdMZ.c.

1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
....
1665
1666
1667
1668
1669
1670
1671

1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
	    }
	}
	break;
    }
    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)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
................................................................................
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    result = 0;
	    failat = 0;
	}
	break;

    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}






<
<
<
<
<







 







>





<







1618
1619
1620
1621
1622
1623
1624





1625
1626
1627
1628
1629
1630
1631
....
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672

1673
1674
1675
1676
1677
1678
1679
	    }
	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;





    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
................................................................................
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    result = 0;
	    failat = 0;
	}
	break;
    case STR_IS_INT:
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}


	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}

Changes to generic/tclCompCmdsSZ.c.

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_FALSE, end);
	}

	switch (t) {
	case STR_IS_INT:
	    PUSH(	"1");
	    OP(		EQ);
	    break;
	case STR_IS_WIDE:
	    PUSH(	"2");
	    OP(		LE);
	    break;
	case STR_IS_ENTIER:
	    PUSH(	"3");
	    OP(		LE);






<
<
<







688
689
690
691
692
693
694



695
696
697
698
699
700
701
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_FALSE, end);
	}

	switch (t) {
	case STR_IS_INT:



	case STR_IS_WIDE:
	    PUSH(	"2");
	    OP(		LE);
	    break;
	case STR_IS_ENTIER:
	    PUSH(	"3");
	    OP(		LE);

Changes to generic/tclExecute.c.

5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
	ClientData ptr1, ptr2;
	int type1, type2;
	Tcl_WideInt w1, w2, wResult;

    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 */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_WIDE;
	    }
	}
	TclNewIntObj(objResultPtr, type1);






<
<
<
<
<
<
<
<
<


|







5630
5631
5632
5633
5634
5635
5636









5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
	ClientData ptr1, ptr2;
	int type1, type2;
	Tcl_WideInt w1, w2, wResult;

    case INST_NUM_TYPE:
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;









	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the LLONG_MIN to LLONG_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) {
		type1 = TCL_NUMBER_WIDE;
	    }
	}
	TclNewIntObj(objResultPtr, type1);

Changes to generic/tclInt.h.

2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_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))	\
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= INT_MIN \
	    && (objPtr)->internalRep.wideValue <= INT_MAX)	\






|







|







2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (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)))
#endif

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (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)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= INT_MIN \
	    && (objPtr)->internalRep.wideValue <= INT_MAX)	\

Changes to generic/tclObj.c.

2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
....
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
	if (interp != NULL) {
	    const char *s =
		    "integer value too large to represent as non-long integer";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
................................................................................
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#else
	if (objPtr->typePtr == &tclIntType) {
	    /*
	     * We return any integer in the range -ULONG_MAX 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
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = Tcl_WideAsLong(w);
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif






|







 







|








|







2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
....
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
	return TCL_ERROR;
    }
    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";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
................................................................................
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#else
	if (objPtr->typePtr == &tclIntType) {
	    /*
	     * 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
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= (Tcl_WideInt)(LONG_MIN)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = Tcl_WideAsLong(w);
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif

Changes to generic/tclStubInit.c.

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
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))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
................................................................................
    return result;
}
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
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))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}






|







 







|







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
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)(INT_MIN))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
................................................................................
    return result;
}
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
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)(INT_MIN))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}

Changes to tests/compExpr-old.test.

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
...
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]

# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
................................................................................
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 {
    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
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {






<







 







|


<
<
<







75
76
77
78
79
80
81

82
83
84
85
86
87
88
...
330
331
332
333
334
335
336
337
338
339



340
341
342
343
344
345
346
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]


# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
................................................................................
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.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
    expr {int(1<<63)}
} -9223372036854775808




test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {

Changes to tests/expr.test.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
....
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
....
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::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.

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]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
................................................................................
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
    set max_wide 9223372036854775807
    string is integer $max_wide

................................................................................
        [expr {$max_wide_str + 0}] \
        [expr {$max_wide + 0}] \
        [expr {9223372036854775807 + 0}] \
        [expr {$max_wide == $max_wide_hex}] \
        [expr {wide(9223372036854775807 + 1) < 0}] \

} {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1}
test expr-33.4 {parse smallest wide value} wideIs64bit {
    set min_wide_str -9223372036854775808
    set min_wide_hex "-0x8000000000000000 "

    set min_wide -9223372036854775808
    # Convert to wide integer
    string is integer $min_wide

................................................................................
} {1 * -2147483646 + -2 = -2147483648}

# 64bit wide integer checks

set min -9223372036854775808
set max 9223372036854775807

test expr-36.1 {expr edge cases} {wideIs64bit} {
    expr {$min / $min}
} {1}
test expr-36.2 {expr edge cases} {wideIs64bit} {
    expr {$min % $min}
} {0}
test expr-36.3 {expr edge cases} {wideIs64bit} {
    expr {$min / ($min + 1)}
} {1}
test expr-36.4 {expr edge cases} {wideIs64bit} {
    expr {$min % ($min + 1)}
} {-1}
test expr-36.5 {expr edge cases} {wideIs64bit} {
    expr {$min / ($min + 2)}
} {1}
test expr-36.6 {expr edge cases} {wideIs64bit} {
    expr {$min % ($min + 2)}
} {-2}
test expr-36.7 {expr edge cases} {wideIs64bit} {
    expr {$min / ($min + 3)}
} {1}
test expr-36.8 {expr edge cases} {wideIs64bit} {
    expr {$min % ($min + 3)}
} {-3}
test expr-36.9 {expr edge cases} {wideIs64bit} {
    expr {$min / -3}
} {3074457345618258602}
test expr-36.10 {expr edge cases} {wideIs64bit} {
    expr {$min % -3}
} {-2}
test expr-36.11 {expr edge cases} {wideIs64bit} {
    expr {$min / -2}
} {4611686018427387904}
test expr-36.12 {expr edge cases} {wideIs64bit} {
    expr {$min % -2}
} {0}
test expr-36.13 {expr edge cases} wideIs64bit {
    expr {wide($min / -1)}
} $min
test expr-36.14 {expr edge cases} {wideIs64bit} {
    expr {$min % -1}
} {0}
test expr-36.15 {expr edge cases} wideIs64bit {
    expr {wide($min * -1)}
} $min
test expr-36.16 {expr edge cases} wideIs64bit {
    expr {wide(-$min)}
} $min
test expr-36.17 {expr edge cases} {wideIs64bit} {
    expr {$min / 1}
} $min
test expr-36.18 {expr edge cases} {wideIs64bit} {
    expr {$min % 1}
} {0}
test expr-36.19 {expr edge cases} {wideIs64bit} {
    expr {$min / 2}
} {-4611686018427387904}
test expr-36.20 {expr edge cases} {wideIs64bit} {
    expr {$min % 2}
} {0}
test expr-36.21 {expr edge cases} {wideIs64bit} {
    expr {$min / 3}
} {-3074457345618258603}
test expr-36.22 {expr edge cases} {wideIs64bit} {
    expr {$min % 3}
} {1}
test expr-36.23 {expr edge cases} {wideIs64bit} {
    expr {$min / ($max - 3)}
} {-2}
test expr-36.24 {expr edge cases} {wideIs64bit} {
    expr {$min % ($max - 3)}
} {9223372036854775800}
test expr-36.25 {expr edge cases} {wideIs64bit} {
    expr {$min / ($max - 2)}
} {-2}
test expr-36.26 {expr edge cases} {wideIs64bit} {
    expr {$min % ($max - 2)}
} {9223372036854775802}
test expr-36.27 {expr edge cases} {wideIs64bit} {
    expr {$min / ($max - 1)}
} {-2}
test expr-36.28 {expr edge cases} {wideIs64bit} {
    expr {$min % ($max - 1)}
} {9223372036854775804}
test expr-36.29 {expr edge cases} {wideIs64bit} {
    expr {$min / $max}
} {-2}
test expr-36.30 {expr edge cases} {wideIs64bit} {
    expr {$min % $max}
} {9223372036854775806}
test expr-36.31 {expr edge cases} {wideIs64bit} {
    expr {$max / $max}
} {1}
test expr-36.32 {expr edge cases} {wideIs64bit} {
    expr {$max % $max}
} {0}
test expr-36.33 {expr edge cases} {wideIs64bit} {
    expr {$max / ($max - 1)}
} {1}
test expr-36.34 {expr edge cases} {wideIs64bit} {
    expr {$max % ($max - 1)}
} {1}
test expr-36.35 {expr edge cases} {wideIs64bit} {
    expr {$max / ($max - 2)}
} {1}
test expr-36.36 {expr edge cases} {wideIs64bit} {
    expr {$max % ($max - 2)}
} {2}
test expr-36.37 {expr edge cases} {wideIs64bit} {
    expr {$max / ($max - 3)}
} {1}
test expr-36.38 {expr edge cases} {wideIs64bit} {
    expr {$max % ($max - 3)}
} {3}
test expr-36.39 {expr edge cases} {wideIs64bit} {
    expr {$max / 3}
} {3074457345618258602}
test expr-36.40 {expr edge cases} {wideIs64bit} {
    expr {$max % 3}
} {1}
test expr-36.41 {expr edge cases} {wideIs64bit} {
    expr {$max / 2}
} {4611686018427387903}
test expr-36.42 {expr edge cases} {wideIs64bit} {
    expr {$max % 2}
} {1}
test expr-36.43 {expr edge cases} {wideIs64bit} {
    expr {$max / 1}
} $max
test expr-36.44 {expr edge cases} {wideIs64bit} {
    expr {$max % 1}
} {0}
test expr-36.45 {expr edge cases} {wideIs64bit} {
    expr {$max / -1}
} "-$max"
test expr-36.46 {expr edge cases} {wideIs64bit} {
    expr {$max % -1}
} {0}
test expr-36.47 {expr edge cases} {wideIs64bit} {
    expr {$max / -2}
} {-4611686018427387904}
test expr-36.48 {expr edge cases} {wideIs64bit} {
    expr {$max % -2}
} {-1}
test expr-36.49 {expr edge cases} {wideIs64bit} {
    expr {$max / -3}
} {-3074457345618258603}
test expr-36.50 {expr edge cases} {wideIs64bit} {
    expr {$max % -3}
} {-2}
test expr-36.51 {expr edge cases} {wideIs64bit} {
    expr {$max / ($min + 3)}
} {-2}
test expr-36.52 {expr edge cases} {wideIs64bit} {
    expr {$max % ($min + 3)}
} {-9223372036854775803}
test expr-36.53 {expr edge cases} {wideIs64bit} {
    expr {$max / ($min + 2)}
} {-2}
test expr-36.54 {expr edge cases} {wideIs64bit} {
    expr {$max % ($min + 2)}
} {-9223372036854775805}
test expr-36.55 {expr edge cases} {wideIs64bit} {
    expr {$max / ($min + 1)}
} {-1}
test expr-36.56 {expr edge cases} {wideIs64bit} {
    expr {$max % ($min + 1)}
} {0}
test expr-36.57 {expr edge cases} {wideIs64bit} {
    expr {$max / $min}
} {-1}
test expr-36.58 {expr edge cases} {wideIs64bit} {
    expr {$max % $min}
} {-1}
test expr-36.59 {expr edge cases} {wideIs64bit} {
    expr {($min + 1) / ($max - 1)}
} {-2}
test expr-36.60 {expr edge cases} {wideIs64bit} {
    expr {($min + 1) % ($max - 1)}
} {9223372036854775805}
test expr-36.61 {expr edge cases} {wideIs64bit} {
    expr {($max - 1) / ($min + 1)}
} {-1}
test expr-36.62 {expr edge cases} {wideIs64bit} {
    expr {($max - 1) % ($min + 1)}
} {-1}
test expr-36.63 {expr edge cases} {wideIs64bit} {
    expr {($max - 1) / $min}
} {-1}
test expr-36.64 {expr edge cases} {wideIs64bit} {
    expr {($max - 1) % $min}
} {-2}
test expr-36.65 {expr edge cases} {wideIs64bit} {
    expr {($max - 2) / $min}
} {-1}
test expr-36.66 {expr edge cases} {wideIs64bit} {
    expr {($max - 2) % $min}
} {-3}
test expr-36.67 {expr edge cases} {wideIs64bit} {
    expr {($max - 3) / $min}
} {-1}
test expr-36.68 {expr edge cases} {wideIs64bit} {
    expr {($max - 3) % $min}
} {-4}
test expr-36.69 {expr edge cases} {wideIs64bit} {
    expr {-3 / $min}
} {0}
test expr-36.70 {expr edge cases} {wideIs64bit} {
    expr {-3 % $min}
} {-3}
test expr-36.71 {expr edge cases} {wideIs64bit} {
    expr {-2 / $min}
} {0}
test expr-36.72 {expr edge cases} {wideIs64bit} {
    expr {-2 % $min}
} {-2}
test expr-36.73 {expr edge cases} {wideIs64bit} {
    expr {-1 / $min}
} {0}
test expr-36.74 {expr edge cases} {wideIs64bit} {
    expr {-1 % $min}
} {-1}
test expr-36.75 {expr edge cases} {wideIs64bit} {
    expr {0 / $min}
} {0}
test expr-36.76 {expr edge cases} {wideIs64bit} {
    expr {0 % $min}
} {0}
test expr-36.77 {expr edge cases} {wideIs64bit} {
    expr {0 / ($min + 1)}
} {0}
test expr-36.78 {expr edge cases} {wideIs64bit} {
    expr {0 % ($min + 1)}
} {0}
test expr-36.79 {expr edge cases} {wideIs64bit} {
    expr {1 / $min}
} {-1}
test expr-36.80 {expr edge cases} {wideIs64bit} {
    expr {1 % $min}
} {-9223372036854775807}
test expr-36.81 {expr edge cases} {wideIs64bit} {
    expr {1 / ($min + 1)}
} {-1}
test expr-36.82 {expr edge cases} {wideIs64bit} {
    expr {1 % ($min + 1)}
} {-9223372036854775806}
test expr-36.83 {expr edge cases} {wideIs64bit} {
    expr {2 / $min}
} {-1}
test expr-36.84 {expr edge cases} {wideIs64bit} {
    expr {2 % $min}
} {-9223372036854775806}
test expr-36.85 {expr edge cases} {wideIs64bit} {
    expr {2 / ($min + 1)}
} {-1}
test expr-36.86 {expr edge cases} {wideIs64bit} {
    expr {2 % ($min + 1)}
} {-9223372036854775805}
test expr-36.87 {expr edge cases} {wideIs64bit} {
    expr {3 / $min}
} {-1}
test expr-36.88 {expr edge cases} {wideIs64bit} {
    expr {3 % $min}
} {-9223372036854775805}
test expr-36.89 {expr edge cases} {wideIs64bit} {
    expr {3 / ($min + 1)}
} {-1}
test expr-36.90 {expr edge cases} {wideIs64bit} {
    expr {3 % ($min + 1)}
} {-9223372036854775804}

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} {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} {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} {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} {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} {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} {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} {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} {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} {wideIs64bit} {
    # Multiplication overflows 64 bit type here,
    # so when the 1 is added it overflows
    # again and we end up back at min.
    set dividend $min
    set divisor 3
    set q [expr {$dividend / $divisor}]
    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} {
    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} {
    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} {
    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} {
    set dividend $min
    set divisor [expr {$min + 2}]
    set q [expr {$dividend / $divisor}]
    set r [expr {$dividend % $divisor}]
    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} {
    expr {abs(-2147483648)}
} 2147483648
test expr-38.2 {abs and -0 [Bug 1893815]} {
    expr {abs(-0)}
} 0
test expr-38.3 {abs and -0 [Bug 1893815]} {
    expr {abs(-0.0)}






|
<



<
<







 







|







 







|







 







|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|



|






|






|






|






|






|






|






|






|






|









|






|






|






|







|







14
15
16
17
18
19
20
21

22
23
24


25
26
27
28
29
30
31
....
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
....
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
....
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Determine if "long int" type is a 32 bit number.


testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]



# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
................................................................................
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
    set max_wide 9223372036854775807
    string is integer $max_wide

................................................................................
        [expr {$max_wide_str + 0}] \
        [expr {$max_wide + 0}] \
        [expr {9223372036854775807 + 0}] \
        [expr {$max_wide == $max_wide_hex}] \
        [expr {wide(9223372036854775807 + 1) < 0}] \

} {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1}
test expr-33.4 {parse smallest wide value} {
    set min_wide_str -9223372036854775808
    set min_wide_hex "-0x8000000000000000 "

    set min_wide -9223372036854775808
    # Convert to wide integer
    string is integer $min_wide

................................................................................
} {1 * -2147483646 + -2 = -2147483648}

# 64bit wide integer checks

set min -9223372036854775808
set max 9223372036854775807

test expr-36.1 {expr edge cases} {
    expr {$min / $min}
} {1}
test expr-36.2 {expr edge cases} {
    expr {$min % $min}
} {0}
test expr-36.3 {expr edge cases} {
    expr {$min / ($min + 1)}
} {1}
test expr-36.4 {expr edge cases} {
    expr {$min % ($min + 1)}
} {-1}
test expr-36.5 {expr edge cases} {
    expr {$min / ($min + 2)}
} {1}
test expr-36.6 {expr edge cases} {
    expr {$min % ($min + 2)}
} {-2}
test expr-36.7 {expr edge cases} {
    expr {$min / ($min + 3)}
} {1}
test expr-36.8 {expr edge cases} {
    expr {$min % ($min + 3)}
} {-3}
test expr-36.9 {expr edge cases} {
    expr {$min / -3}
} {3074457345618258602}
test expr-36.10 {expr edge cases} {
    expr {$min % -3}
} {-2}
test expr-36.11 {expr edge cases} {
    expr {$min / -2}
} {4611686018427387904}
test expr-36.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-36.13 {expr edge cases} {
    expr {wide($min / -1)}
} $min
test expr-36.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-36.15 {expr edge cases} {
    expr {wide($min * -1)}
} $min
test expr-36.16 {expr edge cases} {
    expr {wide(-$min)}
} $min
test expr-36.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-36.18 {expr edge cases} {
    expr {$min % 1}
} {0}
test expr-36.19 {expr edge cases} {
    expr {$min / 2}
} {-4611686018427387904}
test expr-36.20 {expr edge cases} {
    expr {$min % 2}
} {0}
test expr-36.21 {expr edge cases} {
    expr {$min / 3}
} {-3074457345618258603}
test expr-36.22 {expr edge cases} {
    expr {$min % 3}
} {1}
test expr-36.23 {expr edge cases} {
    expr {$min / ($max - 3)}
} {-2}
test expr-36.24 {expr edge cases} {
    expr {$min % ($max - 3)}
} {9223372036854775800}
test expr-36.25 {expr edge cases} {
    expr {$min / ($max - 2)}
} {-2}
test expr-36.26 {expr edge cases} {
    expr {$min % ($max - 2)}
} {9223372036854775802}
test expr-36.27 {expr edge cases} {
    expr {$min / ($max - 1)}
} {-2}
test expr-36.28 {expr edge cases} {
    expr {$min % ($max - 1)}
} {9223372036854775804}
test expr-36.29 {expr edge cases} {
    expr {$min / $max}
} {-2}
test expr-36.30 {expr edge cases} {
    expr {$min % $max}
} {9223372036854775806}
test expr-36.31 {expr edge cases} {
    expr {$max / $max}
} {1}
test expr-36.32 {expr edge cases} {
    expr {$max % $max}
} {0}
test expr-36.33 {expr edge cases} {
    expr {$max / ($max - 1)}
} {1}
test expr-36.34 {expr edge cases} {
    expr {$max % ($max - 1)}
} {1}
test expr-36.35 {expr edge cases} {
    expr {$max / ($max - 2)}
} {1}
test expr-36.36 {expr edge cases} {
    expr {$max % ($max - 2)}
} {2}
test expr-36.37 {expr edge cases} {
    expr {$max / ($max - 3)}
} {1}
test expr-36.38 {expr edge cases} {
    expr {$max % ($max - 3)}
} {3}
test expr-36.39 {expr edge cases} {
    expr {$max / 3}
} {3074457345618258602}
test expr-36.40 {expr edge cases} {
    expr {$max % 3}
} {1}
test expr-36.41 {expr edge cases} {
    expr {$max / 2}
} {4611686018427387903}
test expr-36.42 {expr edge cases} {
    expr {$max % 2}
} {1}
test expr-36.43 {expr edge cases} {
    expr {$max / 1}
} $max
test expr-36.44 {expr edge cases} {
    expr {$max % 1}
} {0}
test expr-36.45 {expr edge cases} {
    expr {$max / -1}
} "-$max"
test expr-36.46 {expr edge cases} {
    expr {$max % -1}
} {0}
test expr-36.47 {expr edge cases} {
    expr {$max / -2}
} {-4611686018427387904}
test expr-36.48 {expr edge cases} {
    expr {$max % -2}
} {-1}
test expr-36.49 {expr edge cases} {
    expr {$max / -3}
} {-3074457345618258603}
test expr-36.50 {expr edge cases} {
    expr {$max % -3}
} {-2}
test expr-36.51 {expr edge cases} {
    expr {$max / ($min + 3)}
} {-2}
test expr-36.52 {expr edge cases} {
    expr {$max % ($min + 3)}
} {-9223372036854775803}
test expr-36.53 {expr edge cases} {
    expr {$max / ($min + 2)}
} {-2}
test expr-36.54 {expr edge cases} {
    expr {$max % ($min + 2)}
} {-9223372036854775805}
test expr-36.55 {expr edge cases} {
    expr {$max / ($min + 1)}
} {-1}
test expr-36.56 {expr edge cases} {
    expr {$max % ($min + 1)}
} {0}
test expr-36.57 {expr edge cases} {
    expr {$max / $min}
} {-1}
test expr-36.58 {expr edge cases} {
    expr {$max % $min}
} {-1}
test expr-36.59 {expr edge cases} {
    expr {($min + 1) / ($max - 1)}
} {-2}
test expr-36.60 {expr edge cases} {
    expr {($min + 1) % ($max - 1)}
} {9223372036854775805}
test expr-36.61 {expr edge cases} {
    expr {($max - 1) / ($min + 1)}
} {-1}
test expr-36.62 {expr edge cases} {
    expr {($max - 1) % ($min + 1)}
} {-1}
test expr-36.63 {expr edge cases} {
    expr {($max - 1) / $min}
} {-1}
test expr-36.64 {expr edge cases} {
    expr {($max - 1) % $min}
} {-2}
test expr-36.65 {expr edge cases} {
    expr {($max - 2) / $min}
} {-1}
test expr-36.66 {expr edge cases} {
    expr {($max - 2) % $min}
} {-3}
test expr-36.67 {expr edge cases} {
    expr {($max - 3) / $min}
} {-1}
test expr-36.68 {expr edge cases} {
    expr {($max - 3) % $min}
} {-4}
test expr-36.69 {expr edge cases} {
    expr {-3 / $min}
} {0}
test expr-36.70 {expr edge cases} {
    expr {-3 % $min}
} {-3}
test expr-36.71 {expr edge cases} {
    expr {-2 / $min}
} {0}
test expr-36.72 {expr edge cases} {
    expr {-2 % $min}
} {-2}
test expr-36.73 {expr edge cases} {
    expr {-1 / $min}
} {0}
test expr-36.74 {expr edge cases} {
    expr {-1 % $min}
} {-1}
test expr-36.75 {expr edge cases} {
    expr {0 / $min}
} {0}
test expr-36.76 {expr edge cases} {
    expr {0 % $min}
} {0}
test expr-36.77 {expr edge cases} {
    expr {0 / ($min + 1)}
} {0}
test expr-36.78 {expr edge cases} {
    expr {0 % ($min + 1)}
} {0}
test expr-36.79 {expr edge cases} {
    expr {1 / $min}
} {-1}
test expr-36.80 {expr edge cases} {
    expr {1 % $min}
} {-9223372036854775807}
test expr-36.81 {expr edge cases} {
    expr {1 / ($min + 1)}
} {-1}
test expr-36.82 {expr edge cases} {
    expr {1 % ($min + 1)}
} {-9223372036854775806}
test expr-36.83 {expr edge cases} {
    expr {2 / $min}
} {-1}
test expr-36.84 {expr edge cases} {
    expr {2 % $min}
} {-9223372036854775806}
test expr-36.85 {expr edge cases} {
    expr {2 / ($min + 1)}
} {-1}
test expr-36.86 {expr edge cases} {
    expr {2 % ($min + 1)}
} {-9223372036854775805}
test expr-36.87 {expr edge cases} {
    expr {3 / $min}
} {-1}
test expr-36.88 {expr edge cases} {
    expr {3 % $min}
} {-9223372036854775805}
test expr-36.89 {expr edge cases} {
    expr {3 / ($min + 1)}
} {-1}
test expr-36.90 {expr edge cases} {
    expr {3 % ($min + 1)}
} {-9223372036854775804}

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} {
    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} {
    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} {
    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} {
    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} {
    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} {
    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} {
    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} {
    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} {
    # Multiplication overflows 64 bit type here,
    # so when the 1 is added it overflows
    # again and we end up back at min.
    set dividend $min
    set divisor 3
    set q [expr {$dividend / $divisor}]
    set r [expr {$dividend % $divisor}]
    list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {-3074457345618258603 * 3 + 1 = -9223372036854775808}
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} {
    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} {
    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} {
    set dividend $min
    set divisor [expr {$min + 2}]
    set q [expr {$dividend / $divisor}]
    set r [expr {$dividend % $divisor}]
    list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {1 * -9223372036854775806 + -2 = -9223372036854775808}

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]} {
    expr {abs(-0)}
} 0
test expr-38.3 {abs and -0 [Bug 1893815]} {
    expr {abs(-0.0)}

Changes to tests/format.test.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
...
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %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} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
................................................................................
for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
    format %d 7810179016327718216
} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
    format %ld 7810179016327718216
} 7810179016327718216
test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
    format %ld 42
} 42
test format-17.4 {testing %l with non-integer} {
    format %lf 1
} 1.000000
test format-17.5 {testing %llu with positive bignum} -body {
    format %llu 0xabcdef0123456789abcdef
................................................................................
    lappend result [expr {$a == $b}]
    set b 0xaaaa
    append b aaaa
    lappend result [expr {$a == $b}]
    format %08x $b
    lappend result [expr {$a == $b}]
} {1 1 1 1}
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}]
} {aaaaaaab 1}

test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
    set x 0x8fedc654
    list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
test format-19.2 {Bug 1867855} {
    format %llx 0






<
<
<







 







|

|
|


|







 







|



|







14
15
16
17
18
19
20



21
22
23
24
25
26
27
...
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
...
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %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 pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
 
test format-1.1 {integer formatting} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
................................................................................
for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {
    format %d 7810179016327718216
} 7810179016327718216
test format-17.2 {testing %ld with wide} {
    format %ld 7810179016327718216
} 7810179016327718216
test format-17.3 {testing %ld with non-wide} {
    format %ld 42
} 42
test format-17.4 {testing %l with non-integer} {
    format %lf 1
} 1.000000
test format-17.5 {testing %llu with positive bignum} -body {
    format %llu 0xabcdef0123456789abcdef
................................................................................
    lappend result [expr {$a == $b}]
    set b 0xaaaa
    append b aaaa
    lappend result [expr {$a == $b}]
    format %08x $b
    lappend result [expr {$a == $b}]
} {1 1 1 1}
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}]
} {aaaaaaaaab 1}

test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
    set x 0x8fedc654
    list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
test format-19.2 {Bug 1867855} {
    format %llx 0

Changes to tests/obj.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
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
    foreach {t} {
	bytearray
	bytecode
	cmdName
................................................................................
    set x {}
    for {set i 0} {$i<100000} {incr i} {
	set x [list $x {}]
    }
    unset x
} {}

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} {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) }]
} {0 4294967296}
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} {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} {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) }]
} {0 -4294967296}

test obj-34.1 {mp_iseven} testobj {
    set result ""
    lappend result [testbignumobj set 1 0]
    lappend result [testbignumobj iseven 1]    ;
    lappend result [testobj type 1]
} {0 1 int}






<
<







 







|



|






|
|



|



|






|







16
17
18
19
20
21
22


23
24
25
26
27
28
29
...
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]



test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	bytearray
	bytecode
	cmdName
................................................................................
    set x {}
    for {set i 0} {$i<100000} {incr i} {
	set x [list $x {}]
    }
    unset x
} {}

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} {
    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 -0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483648}
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} {
    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}

test obj-34.1 {mp_iseven} testobj {
    set result ""
    lappend result [testbignumobj set 1 0]
    lappend result [testbignumobj iseven 1]    ;
    lappend result [testobj type 1]
} {0 1 int}

Changes to tests/scan.test.

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
 
test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}
................................................................................
#
test scan-5.11 {integer scanning} -constraints {nonPortable} -setup {
    set a {}; set b {}
} -body {
    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 {
    set a {}; set b {}; set c {}
} -body {
    list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \
	    %ld,%lx,%lo a b c] $a $b $c
} -result {3 7810179016327718216 7810179016327718216 7810179016327718216}
test scan-5.13 {integer scanning and overflow} {
    # This test used to fail on some 64-bit systems. [Bug 1011860]






<
<







 







|







81
82
83
84
85
86
87


88
89
90
91
92
93
94
...
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]


 
test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}
................................................................................
#
test scan-5.11 {integer scanning} -constraints {nonPortable} -setup {
    set a {}; set b {}
} -body {
    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 {
    set a {}; set b {}; set c {}
} -body {
    list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \
	    %ld,%lx,%lo a b c] $a $b $c
} -result {3 7810179016327718216 7810179016327718216 7810179016327718216}
test scan-5.13 {integer scanning and overflow} {
    # This test used to fail on some 64-bit systems. [Bug 1011860]

Changes to tests/string.test.

803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [run {string is double -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92.$noComp {string is integer, 32-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} {
    # Bug 718878
    set x 0x100000000
    append x ""
    list [run {string is integer -failindex var $x}] $var
} {0 -1}
test string-6.94.$noComp {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [run {string is integer -failindex var [expr {$x}]}] $var
} {0 -1}
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}






|

|


|

|



|

|







803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [run {string is double -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92.$noComp {string is integer, 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} {
    # 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} {
    # Bug 718878
    set x 0x10000000000000000
    list [run {string is integer -failindex var [expr {$x}]}] $var
} {0 -1}
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}

Changes to tests/uplevel.test.

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} {
    apply {{} {uplevel -0xffffffff {}}}
} {}
test uplevel-4.18 {level parsing} {
    apply {{} {uplevel #-0xffffffff {}}}
} {}
test uplevel-4.19 {level parsing} {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} {}
test uplevel-4.20 {level parsing} {
    apply {{} {uplevel #[expr -0xffffffff] {}}}
} {}
test uplevel-4.21 {level parsing} -body {
    apply {{} {uplevel -1 {}}}
} -returnCodes error -result {invalid command name "-1"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {






|

|
|

|
|

|
|

|







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} -returnCodes error -body {
    apply {{} {uplevel -0xffffffff {}}}
} -result {invalid command name "-0xffffffff"}
test uplevel-4.18 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #-0xffffffff {}}}
} -result {bad level "#-0xffffffff"}
test uplevel-4.19 {level parsing} -returnCodes error -body {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} -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"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {