Check-in [af0ec25f4d]
Not logged in

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

Overview
Comment:(partial) fix for [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a]: Bugs in the implementation of TIP 577 ("Enhanced index values for Tk" )
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: af0ec25f4d4eb98a80ac9ea26463f8cba59d3cc30f94e360871aa0c4f9f42611
User & Date: jan.nijtmans 2023-06-21 22:38:58.936
Context
2023-06-22
13:40
Merge-mark check-in: b4712d2e1f user: jan.nijtmans tags: core-8-branch
11:59
Proposed fix for [44452e2c55]: indexObj.test failures on i386 Closed-Leaf check-in: 05df422a98 user: jan.nijtmans tags: bug-44452e2c55
2023-06-21
22:44
merge-mark check-in: 9dbdcdf63c user: jan.nijtmans tags: trunk, main
22:38
(partial) fix for [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a]: Bugs in the implemen... check-in: af0ec25f4d user: jan.nijtmans tags: core-8-branch
21:30
Fix 3 "lset" testcases Closed-Leaf check-in: 8d300901a0 user: jan.nijtmans tags: bug-a9929f112a
07:13
"trace variable" -> "trace add variable" in testcases (and documentation) check-in: 8dd5496bd1 user: jan.nijtmans tags: core-8-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclListObj.c.
2867
2868
2869
2870
2871
2872
2873



2874
2875
2876
2877
2878
2879
2880
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;




	if (index < 0 || index > elemCount
	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));







>
>
>







2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;

	if ((index == INT_MAX) && (elemCount == 0)) {
	    index = 0;
	}
	if (index < 0 || index > elemCount
	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));
Changes to generic/tclUtil.c.
3656
3657
3658
3659
3660
3661
3662



3663
3664
3665
3666
3667
3668
3669
    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;



	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    return TCL_OK;







>
>
>







3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;
	    if ((*widePtr < 0)) {
		*widePtr = WIDE_MIN;
	    }
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    return TCL_OK;
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {
	*widePtr = -1;
    } else if (endValue == (size_t)-1) {
	*widePtr = offset;
    } else if (offset < 0) {
	/* Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;







|







3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	*widePtr = (endValue == (size_t)-1) ? WIDE_MAX : endValue + 1;
    } else if (offset == WIDE_MIN) {
	*widePtr = -1;
    } else if (endValue == (size_t)-1) {
	*widePtr = offset;
    } else if (offset < 0) {
	/* Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;
Changes to tests/indexObj.test.
207
208
209
210
211
212
213
214
215
216
217






218
219
220
221
222
223
224
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1







# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl







|



>
>
>
>
>
>







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 2147483647
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1
test indexObj-8.16 {Tcl_GetIntForIndex integer} testgetintforindex {
    testgetintforindex -1 -1
} -2147483648
test indexObj-8.17 {Tcl_GetIntForIndex integer} testgetintforindex {
    testgetintforindex -2 -1
} -2147483648

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl