From aa0e1c2bd9fdf410f64757221acca981bf233f25 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sun, 13 Aug 2023 06:22:28 +0000 Subject: Revert [0b05b5c750df] that broke bigdata tests and lseq-1.13 --- generic/tclCompCmdsGR.c | 4 +- generic/tclCompile.h | 2 +- generic/tclListObj.c | 3 - generic/tclUtil.c | 218 +++++++++++++++++++++++++++++++++++------------- tests/indexObj.test | 14 +--- tests/lseq.test | 2 +- 6 files changed, 166 insertions(+), 77 deletions(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 892387e..f35cd50 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -49,8 +49,8 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, int TclGetIndexFromToken( Tcl_Token *tokenPtr, - int before, - int after, + size_t before, + size_t after, int *indexPtr) { Tcl_Obj *tmpObj; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 90ae8a7..161ea62 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1138,7 +1138,7 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr); MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr, - int before, int after, int *indexPtr); + size_t before, size_t after, int *indexPtr); MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr); MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, CompileEnv *envPtr); diff --git a/generic/tclListObj.c b/generic/tclListObj.c index fa94b3f..dac75d4 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2927,9 +2927,6 @@ TclLsetFlat( } indexArray++; - if ((index == TCL_SIZE_MAX) && (elemCount == 0)) { - index = 0; - } if (index < 0 || index > elemCount || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 79433e1..80e4721 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -138,7 +138,7 @@ TclLengthOne( { return 1; } - + /* * * STRING REPRESENTATION OF LISTS * * * * @@ -3382,15 +3382,12 @@ GetWideForIndex( if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; - if ((*widePtr < 0)) { - *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)) ? ((endValue == -1) ? WIDE_MIN : -1) : WIDE_MAX); + *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX); return TCL_OK; } } @@ -3412,12 +3409,14 @@ GetWideForIndex( * (0..TCL_SIZE_MAX) it is returned. Higher values are returned as * TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1). * + * Callers should pass reasonable values for endValue - one in the + * valid index range or TCL_INDEX_NONE (-1), for example for an empty + * list. * * Results: * TCL_OK * - * The index is stored at the address given by by 'indexPtr'. If - * 'objPtr' has the value "end", the value stored is 'endValue'. + * The index is stored at the address given by by 'indexPtr'. * * TCL_ERROR * @@ -3425,10 +3424,9 @@ GetWideForIndex( * 'interp' is non-NULL, an error message is left in the interpreter's * result object. * - * Effect + * Side effects: * - * The object referenced by 'objPtr' is converted, as needed, to an - * integer, wide integer, or end-based-index object. + * The internal representation contained within objPtr may shimmer. * *---------------------------------------------------------------------- */ @@ -3450,14 +3448,13 @@ Tcl_GetIntForIndex( return TCL_ERROR; } if (indexPtr != NULL) { - if ((wide < 0) && (endValue >= 0)) { - *indexPtr = TCL_INDEX_NONE; + /* Note: check against TCL_SIZE_MAX needed for 32-bit builds */ + if (wide >= 0 && wide <= TCL_SIZE_MAX) { + *indexPtr = (Tcl_Size)wide; } else if (wide > TCL_SIZE_MAX) { *indexPtr = TCL_SIZE_MAX; - } else if (wide < -1-TCL_SIZE_MAX) { - *indexPtr = -1-TCL_SIZE_MAX; } else { - *indexPtr = (Tcl_Size) wide; + *indexPtr = TCL_INDEX_NONE; } } return TCL_OK; @@ -3697,17 +3694,26 @@ GetEndOffsetFromObj( offset = irPtr->wideValue; if (offset == WIDE_MAX) { - *widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1; + /* + * Encodes end+1. This is distinguished from end+n as noted above + * NOTE: this may wrap around if the caller passes (as lset does) + * listLen-1 as endValue and and listLen is 0. The -1 will be + * interpreted as FF...FF and adding 1 will result in 0 which + * is what we want. 2's complements shenanigans but it is what + * it is ... + */ + *widePtr = endValue + 1; } else if (offset == WIDE_MIN) { + /* -1 - position before first */ *widePtr = -1; - } else if (endValue == -1) { - *widePtr = offset; } else if (offset < 0) { - /* Different signs, sum cannot overflow */ - *widePtr = (size_t)endValue + offset + 1; + /* end-(n-1) - Different signs, sum cannot overflow */ + *widePtr = endValue + offset + 1; } else if (offset < WIDE_MAX) { + /* 0:WIDE_MAX-1 - plain old index. */ *widePtr = offset; } else { + /* Huh, what case remains here? */ *widePtr = WIDE_MAX; } return TCL_OK; @@ -3732,19 +3738,26 @@ GetEndOffsetFromObj( *---------------------------------------------------------------------- * * TclIndexEncode -- + * IMPORTANT: function only encodes indices in the range that fits within + * an "int" type. Do NOT change this as the byte code compiler and engine + * which call this function cannot handle wider index types. Indices + * outside the range will result in the function returning an error. * * Parse objPtr to determine if it is an index value. Two cases * are possible. The value objPtr might be parsed as an absolute - * index value in the C signed int range. Note that this includes + * index value in the Tcl_Size range. Note that this includes * index values that are integers as presented and it includes index - * arithmetic expressions. The absolute index values that can be + * arithmetic expressions. + * + * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. + * This means the largest supported character length is also TCL_SIZE_MAX, + * and the index of the last character in a string of length TCL_SIZE_MAX + * is TCL_SIZE_MAX-1. Thus the absolute index values that can be * directly meaningful as an index into either a list or a string are - * those integer values >= TCL_INDEX_START (0) - * and < INT_MAX. - * The largest string supported in Tcl 8 has bytelength INT_MAX. - * This means the largest supported character length is also INT_MAX, - * and the index of the last character in a string of length INT_MAX - * is INT_MAX-1. + * integer values in the range 0 to TCL_SIZE_MAX - 1. + * + * This function however can only handle integer indices in the range + * 0 : INT_MAX-1. * * Any absolute index value parsed outside that range is encoded * using the before and after values passed in by the @@ -3769,12 +3782,9 @@ 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. + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the + * index does not fit in an int type. * * Side effects: * When TCL_OK is returned, the encoded index value is written @@ -3787,51 +3797,138 @@ 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 before, /* Value to return for index before beginning */ int after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; + const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX; + + assert(ENDVALUE < WIDE_MAX); + if (TCL_OK != GetWideForIndex(interp, objPtr, ENDVALUE, &wide)) { + return TCL_ERROR; + } + /* + * We passed 2*INT_MAX as the "end value" to GetWideForIndex. The computed + * index will be in one of the following ranges that need to be + * distinguished for encoding purposes in the following code. + * (1) 0:INT_MAX when + * (a) objPtr was a pure non-negative numeric value in that range + * (b) objPtr was a numeric computation M+/-N with a result in that range + * (c) objPtr was of the form end-N where N was in range INT_MAX:2*INT_MAX + * (2) INT_MAX+1:2*INT_MAX when + * (a,b) as above + * (c) objPtr was of the form end-N where N was in range 0:INT_MAX-1 + * (3) 2*INT_MAX:WIDE_MAX when + * (a,b) as above + * (c) objPtr was of the form end+N + * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when + * (a,b) as above + * (c) objPtr was of the form end-N where N was in the range 0:TCL_SIZE_MAX + * (5) WIDE_MIN:(2*INT_MAX)-TCL_SIZE_MAX + * (a,b) as above + * (c) objPtr was of the form end-N where N was > TCL_SIZE_MAX + * + * For all cases (b) and (c), the internal representation of objPtr + * will be shimmered to endOffsetType. That allows us to distinguish between + * (for example) 1a (encodable) and 1c (not encodable) though the computed + * index value is the same. + * + * Further note, the values TCL_SIZE_MAX < N < WIDE_MAX come into play + * only in the 32-bit builds as TCL_SIZE_MAX == WIDE_MAX for 64-bits. + */ + + const Tcl_ObjInternalRep *irPtr = + TclFetchInternalRep(objPtr, &endOffsetType); + + if (irPtr && irPtr->wideValue >= 0) { + /* + * "int[+-]int" syntax, works the same here as "int". + * Note same does not hold for negative integers. + * Distinguishes 1b and 1c where wide will be in 0:INT_MAX for + * both but irPtr->wideValue will be negative for 1c. + */ + irPtr = NULL; + } + + if (irPtr == NULL) { + /* objPtr can be treated as a purely numeric value. */ - if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) { - const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType); - if (irPtr && irPtr->wideValue >= 0) { - /* "int[+-]int" syntax, works the same here as "int" */ - irPtr = NULL; + /* + * On 64-bit systems, indices in the range INT_MAX:TCL_SIZE_MAX are + * valid indices but are not in the encodable range. Thus an + * error is raised. On 32-bit systems, indices in that range indicate + * the position after the end and so do not raise an error. + */ + if ((sizeof(int) != sizeof(Tcl_Size)) && + (wide > INT_MAX) && (wide < WIDE_MAX-1)) { + /* 2(a,b) on 64-bit systems*/ + goto rangeerror; + } + if (wide > INT_MAX) { + /* + * 3(a,b) on 64-bit systems and 2(a,b), 3(a,b) on 32-bit systems + * Because of the check above, this case holds for indices + * greater than INT_MAX on 32-bit systems and > TCL_SIZE_MAX + * on 64-bit systems. Always maps to the element after the end. + */ + idx = after; + } else if (wide < 0) { + /* 4(a,b) (32-bit systems), 5(a,b) - before the beginning */ + idx = before; + } else { + /* 1(a,b) Encodable range */ + idx = (int)wide; } + } else { + /* objPtr is not purely numeric (end etc.) */ + /* - * We parsed an end+offset index value. - * wide holds the offset value in the range WIDE_MIN...WIDE_MAX. + * On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX + * are valid indices (with max size strings/lists) but are not in + * the encodable range. Thus an error is raised. On 32-bit systems, + * indices in that range indicate the position before the beginning + * and so do not raise an error. */ - if ((irPtr ? ((wide < INT_MIN) && ((Tcl_Size)-wide <= LIST_MAX)) - : ((wide > INT_MAX) && ((Tcl_Size)wide <= LIST_MAX))) && (sizeof(int) != sizeof(Tcl_Size))) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%s\" out of range", - TclGetString(objPtr))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" - "OUTOFRANGE", NULL); - } - return TCL_ERROR; - } else if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && + (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) { + /* 1(c), 4(a,b) on 64-bit systems */ + goto rangeerror; + } + if (wide > ENDVALUE) { /* - * All end+postive or end-negative expressions + * 2(c) (32-bit systems), 3(c) + * All end+positive or end-negative expressions * always indicate "after the end". + * Note we will not reach here for a pure numeric value in this + * range because irPtr will be NULL in that case. */ idx = after; - } else if (wide <= (irPtr ? INT_MAX : -1)) { - /* These indices always indicate "before the beginning" */ + } else if (wide <= INT_MAX) { + /* 1(c) (32-bit systems), 4(c) (32-bit systems), 5(c) */ idx = before; } else { - /* Encoded end-positive (or end+negative) are offset */ + /* 2(c) Encodable end-positive (or end+negative) */ idx = (int)wide; } - } else { - return TCL_ERROR; } *indexPtr = idx; return TCL_OK; + +rangeerror: + if (interp) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); + Tcl_SetErrorCode(interp, + "TCL", + "VALUE", + "INDEX" + "OUTOFRANGE", + NULL); + } + return TCL_ERROR; } /* @@ -3857,8 +3954,9 @@ TclIndexDecode( if (encoded > TCL_INDEX_END) { return encoded; } - if ((size_t)endValue >= (size_t)TCL_INDEX_END - encoded) { - return endValue + encoded - TCL_INDEX_END; + endValue += encoded - TCL_INDEX_END; + if (endValue >= 0) { + return endValue; } return TCL_INDEX_NONE; } diff --git a/tests/indexObj.test b/tests/indexObj.test index f8cdf3e..4c01210 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -200,28 +200,22 @@ test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex { } 2147483647 test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex { testgetintforindex end-1 -1 -} -2 +} -1 test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex { testgetintforindex end-1 -2 -} [expr {[testConstraint has64BitLengths] ? -3 : 2147483647}] +} -1 test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex { testgetintforindex end -1 } -1 test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex { testgetintforindex end -2 -} [expr {[testConstraint has64BitLengths] ? -2 : 2147483647}] +} -1 test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex { testgetintforindex end+1 -1 -} [expr {[testConstraint has64BitLengths] ? 9223372036854775807 : 2147483647}] +} 0 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 -} [expr {[testConstraint has64BitLengths] ? -9223372036854775808 : -2147483648}] -test indexObj-8.17 {Tcl_GetIntForIndex integer} testgetintforindex { - testgetintforindex -2 -1 -} [expr {[testConstraint has64BitLengths] ? -9223372036854775808 : -2147483648}] # cleanup ::tcltest::cleanupTests diff --git a/tests/lseq.test b/tests/lseq.test index 5cbf627..7e25654 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -690,7 +690,7 @@ test lseq-4.12.32 {bug lseq} -constraints has32BitLengths -body { llength [lseq 0x100000000] } -returnCodes 1 -result {max length of a Tcl list exceeded} -test lseq-4.13 {bug lseq} -constraints knownBug -body { +test lseq-4.13 {bug lseq} -constraints has64BitLengths -body { set l [lseq 0x7fffffffffffffff] list \ [llength $l] \ -- cgit v0.12