From 7c2d72933f0d49aeac8e89082e833c41bda2b9f9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 21 Jun 2023 14:52:44 +0000 Subject: (partial) fix for [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a]. Tk needs some changes too --- generic/tclUtil.c | 5 ++++- tests/indexObj.test | 8 +++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 30ae39a..074614f 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3660,6 +3660,9 @@ GetWideForIndex( 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) { @@ -3966,7 +3969,7 @@ GetEndOffsetFromObj( offset = irPtr->wideValue; if (offset == WIDE_MAX) { - *widePtr = endValue + 1; + *widePtr = (endValue == (size_t)-1) ? WIDE_MAX : endValue + 1; } else if (offset == WIDE_MIN) { *widePtr = -1; } else if (endValue == (size_t)-1) { diff --git a/tests/indexObj.test b/tests/indexObj.test index 2c50200..1cf782a 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -211,10 +211,16 @@ test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex { } -2 test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex { testgetintforindex end+1 -1 -} 0 +} 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 -- cgit v0.12 From bc87d9a2bc25805bbeda05983b9a403d0767fb1f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 21 Jun 2023 21:30:53 +0000 Subject: Fix 3 "lset" testcases --- generic/tclListObj.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index d3e4f02..0fd489c 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2871,6 +2871,9 @@ TclLsetFlat( } indexArray++; + if ((index == INT_MAX) && (elemCount == 0)) { + index = 0; + } if (index < 0 || index > elemCount || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ -- cgit v0.12 From f35db8a093f135e9bbe9eff49aeac8f033fbc085 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 22 Jun 2023 11:59:58 +0000 Subject: Proposed fix for [44452e2c55]: indexObj.test failures on i386 --- generic/tclInt.h | 2 +- generic/tclUtil.c | 50 ++++++++++++++++++++++++++------------------------ 2 files changed, 27 insertions(+), 25 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 25a23ed..f4bf769 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4219,7 +4219,7 @@ MODULE_SCOPE Tcl_Obj * TclGetArrayDefault(Var *arrayPtr); */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, - int before, int after, int *indexPtr); + Tcl_Size before, Tcl_Size after, int *indexPtr); MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* Constants used in index value encoding routines. */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 074614f..cfc56b0 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -109,10 +109,10 @@ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(void *clientData); static void FreeThreadHash(void *clientData); static int GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t endValue, Tcl_WideInt *indexPtr); + Tcl_WideInt endValue, Tcl_WideInt *indexPtr); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t endValue, Tcl_WideInt *widePtr); + Tcl_WideInt endValue, Tcl_WideInt *widePtr); static int FindElement(Tcl_Interp *interp, const char *string, Tcl_Size stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, @@ -1575,7 +1575,7 @@ Tcl_Merge( { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int i; + Tcl_Size i; unsigned int bytesNeeded = 0; char *result, *dst; @@ -2703,11 +2703,11 @@ Tcl_DStringAppend( /* See [16896d49fd] */ if (bytes >= dsPtr->string && bytes <= dsPtr->string + dsPtr->length) { + /* Source string is within this DString. Note offset */ offset = bytes - dsPtr->string; } - - dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); - + dsPtr->string = + (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { bytes = dsPtr->string + offset; } @@ -2741,7 +2741,7 @@ TclDStringAppendObj( Tcl_Obj *objPtr) { Tcl_Size length; - char *bytes = TclGetStringFromObj(objPtr, &length); + const char *bytes = TclGetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } @@ -2835,11 +2835,11 @@ Tcl_DStringAppendElement( /* See [16896d49fd] */ if (element >= dsPtr->string && element <= dsPtr->string + dsPtr->length) { + /* Source string is within this DString. Note offset */ offset = element - dsPtr->string; } - - dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); - + dsPtr->string = + (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { element = dsPtr->string + offset; } @@ -3646,7 +3646,7 @@ GetWideForIndex( * NULL, then no error message is left after * errors. */ Tcl_Obj *objPtr, /* Points to the value to be parsed */ - size_t endValue, /* The value to be stored at *widePtr if + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ Tcl_WideInt *widePtr) /* Location filled in with a wide integer @@ -3661,14 +3661,14 @@ GetWideForIndex( /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; if ((*widePtr < 0)) { - *widePtr = WIDE_MIN; + *widePtr = (endValue == -1) ? WIDE_MIN : -1; } 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); + *widePtr = ((mp_isneg((mp_int *)cd)) ? ((endValue == -1) ? WIDE_MIN : -1) : WIDE_MAX); return TCL_OK; } } @@ -3686,7 +3686,12 @@ GetWideForIndex( * object. The string value 'objPtr' is expected have the format * integer([+-]integer)? or end([+-]integer)?. * - * Value + * If the computed index lies within the valid range of Tcl indices + * (0..TCL_SIZE_MAX) it is returned. Higher values are returned as + * TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1). + * + * + * Results: * TCL_OK * * The index is stored at the address given by by 'indexPtr'. If @@ -3752,7 +3757,8 @@ Tcl_GetIntForIndex( * -2: Index "end-1" * -1: Index "end" * 0: Index "0" - * WIDE_MAX-1: Index "end+n", for any n > 1 + * WIDE_MAX-1: Index "end+n", for any n > 1. Distinguish from end+1 for + * commands like lset. * WIDE_MAX: Index "end+1" * * Results: @@ -3768,7 +3774,7 @@ static int GetEndOffsetFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, /* Pointer to the object to parse */ - size_t endValue, /* The value to be stored at "indexPtr" if + Tcl_WideInt endValue, /* The value to be stored at "widePtr" if * "objPtr" holds "end". */ Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ @@ -3969,10 +3975,10 @@ GetEndOffsetFromObj( offset = irPtr->wideValue; if (offset == WIDE_MAX) { - *widePtr = (endValue == (size_t)-1) ? WIDE_MAX : endValue + 1; + *widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1; } else if (offset == WIDE_MIN) { *widePtr = -1; - } else if (endValue == (size_t)-1) { + } else if (endValue == -1) { *widePtr = offset; } else if (offset < 0) { /* Different signs, sum cannot overflow */ @@ -4042,10 +4048,6 @@ GetEndOffsetFromObj( * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, * they can be encoded with the before value. * - * These details will require re-examination whenever string and - * list length limits are increased, but that will likely also - * mean a revised routine capable of returning Tcl_WideInt values. - * * Returns: * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. * @@ -4060,8 +4062,8 @@ int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ - int before, /* Value to return for index before beginning */ - int after, /* Value to return for index after end */ + Tcl_Size before, /* Value to return for index before beginning */ + Tcl_Size after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; -- cgit v0.12 From 9df01df02cfe3af447b7fb057da7eb32fa505c52 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 22 Jun 2023 13:39:14 +0000 Subject: Since Tcl 8.6 doesn't know about Tcl_Size, don't use it, not even in test comments --- tests/dstring.test | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/tests/dstring.test b/tests/dstring.test index 59b3459..cb1cc4f 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -425,13 +425,10 @@ test dstring-4.3 {truncation} -constraints testdstring -setup { # Pass a negative length to Tcl_DStringSetLength(); # if not caught, causing '\0' to be written out-of-bounds, # try corrupting dsPtr->length which begins - # 2*sizeof(Tcl_Size) bytes before dsPtr->staticSpace[], + # 2*sizeof(int) bytes before dsPtr->staticSpace[], # so that the result is -256 (on little endian systems) - # rather than e.g. -8 or -16. - # (sizeof(Tcl_Size) does not seem to be available via Tcl, - # so assume sizeof(Tcl_Size) == sizeof(void*) for Tcl 9.) - testdstring trunc [expr {-2*([package vsatisfies $tcl_version 9.0-] - ? $tcl_platform(pointerSize) : 4)}] + # rather than e.g. -8. + testdstring trunc -8 list [testdstring get] [testdstring length] } -cleanup { testdstring free -- cgit v0.12