From c68d043691c94408564f252d18ffce9db7afcdad Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 6 Mar 2018 21:59:53 +0000 Subject: try to fix [db36fa5122]: better compiled variants of several indices-related commands, test-cases extended --- generic/tclCompCmdsGR.c | 57 +++++++++++++++++++++++++++++++++++++++---------- generic/tclCompCmdsSZ.c | 15 +++++++++---- generic/tclCompile.h | 6 ++++-- generic/tclExecute.c | 6 ++++-- tests/lindex.test | 9 ++++++++ tests/lrange.test | 18 ++++++++++++++++ 6 files changed, 92 insertions(+), 19 deletions(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 375653b..a5f2ee4 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -40,6 +40,11 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, * * Returns: * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. + * The return value of *index is: + * >= 0 -- constant index from start, + * == minBoundary -- (TCL_INDEX_OUT_OF_RANGE, 0) if out of range (before start) + * == maxBoundary -- (INT_MAX, TCL_INDEX_OUT_OF_RANGE) if out of range (after end) + * <= -2 -- (<= TCL_INDEX_END) negative index from end. * * Side effects: * Sets *index to the index value if successful. @@ -50,7 +55,9 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, int TclGetIndexFromToken( Tcl_Token *tokenPtr, - int *index) + int *index, + int minBoundary, + int maxBoundary) { Tcl_Obj *tmpObj = Tcl_NewObj(); int result, idx; @@ -62,13 +69,26 @@ TclGetIndexFromToken( result = TclGetIntFromObj(NULL, tmpObj, &idx); if (result == TCL_OK) { - if (idx < 0) { - result = TCL_ERROR; + /* out of range (..., -2] */ + if (idx <= TCL_INDEX_END) { + idx = minBoundary; + /* before start */ } } else { result = TclGetIntForIndexM(NULL, tmpObj, TCL_INDEX_END, &idx); - if (result == TCL_OK && idx > TCL_INDEX_END) { - result = TCL_ERROR; + if (result == TCL_OK) { + int endSyntax = (tmpObj->length >= 3 && *tmpObj->bytes == 'e'); + /* + * Check computed index results to out of range (after end or negative constant), + * set it to -1 in order to avoid ambiguity with "end[+-integer] syntax" + */ + if (idx > TCL_INDEX_END && endSyntax) { + /* after end [end+1, ...) */ + idx = maxBoundary; /* may be TCL_INDEX_OUT_OF_RANGE or INT_MAX */ + } else if (idx < 0 && !endSyntax) { + /* before start, negative constant (..., -1-1] */ + idx = minBoundary; + } } } Tcl_DecrRefCount(tmpObj); @@ -1103,7 +1123,8 @@ TclCompileLindexCmd( } idxTokenPtr = TokenAfter(valTokenPtr); - if (TclGetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) { + if (TclGetIndexFromToken(idxTokenPtr, &idx, + TCL_INDEX_OUT_OF_RANGE, TCL_INDEX_OUT_OF_RANGE) == TCL_OK) { /* * All checks have been completed, and we have exactly one of these * constructs: @@ -1338,14 +1359,17 @@ TclCompileLrangeCmd( */ tokenPtr = TokenAfter(listTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx1, -1, INT_MAX) != TCL_OK) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx2, -1, INT_MAX) != TCL_OK) { return TCL_ERROR; } + if (idx1 == INT_MAX && idx2 == INT_MAX) { + idx2 = TCL_INDEX_OUT_OF_RANGE; + } /* * Issue instructions. It's not safe to skip doing the LIST_RANGE, as @@ -1395,7 +1419,7 @@ TclCompileLinsertCmd( */ tokenPtr = TokenAfter(listTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx, 0, INT_MAX) != TCL_OK) { return TCL_ERROR; } @@ -1490,12 +1514,12 @@ TclCompileLreplaceCmd( */ tokenPtr = TokenAfter(listTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx1, -1, INT_MAX) != TCL_OK) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx2, -1, TCL_INDEX_END) != TCL_OK) { return TCL_ERROR; } @@ -1514,10 +1538,21 @@ TclCompileLreplaceCmd( * now. [Bug 47ac84309b] */ + if (idx1 == INT_MAX) { + /* consider special handling for too large first index + * "list doesn't contain element ...", so still not compiled */ + return TCL_ERROR; + } + if ((idx1 <= TCL_INDEX_END) != (idx2 <= TCL_INDEX_END)) { return TCL_ERROR; } + if (idx1 == -1) { + /* linsert before start or replace from start */ + idx1 = 0; + } + if (idx2 != TCL_INDEX_END && idx2 >= 0 && idx2 < idx1) { idx2 = idx1 - 1; } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index fb0981d..ef1a4b0 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -934,12 +934,15 @@ TclCompileStringRangeCmd( * Parse the two indices. */ - if (TclGetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(fromTokenPtr, &idx1, -1, INT_MAX) != TCL_OK) { goto nonConstantIndices; } - if (TclGetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(toTokenPtr, &idx2, -1, INT_MAX) != TCL_OK) { goto nonConstantIndices; } + if (idx1 == INT_MAX && idx2 == INT_MAX) { + idx2 = TCL_INDEX_OUT_OF_RANGE; + } /* * Push the operand onto the stack and then the substring operation. @@ -992,12 +995,16 @@ TclCompileStringReplaceCmd( */ tokenPtr = TokenAfter(valueTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx1, -1, INT_MAX) != TCL_OK) { goto genericReplace; } tokenPtr = TokenAfter(tokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx2, -1, INT_MAX) != TCL_OK) { + goto genericReplace; + } + if (idx1 == INT_MAX && idx2 == INT_MAX) { + /* avoid replacement of last char in large string (just don't compile). */ goto genericReplace; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 1c64a21..2f23b90 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1121,7 +1121,8 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, int distThreshold); MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr); MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); -MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr, int *index); +MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr, int *index, + int minBoundary, int maxBoundary); MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, @@ -1688,7 +1689,8 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * Special value used by TclGetIndexFromToken to encoding the "end" index. */ -#define TCL_INDEX_END (-2) +#define TCL_INDEX_END (-2) +#define TCL_INDEX_OUT_OF_RANGE (-1) /* * DTrace probe macros (NOPs if DTrace support is not enabled). diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 93ed50b..d345899 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5091,7 +5091,7 @@ TEBCresume( /* * Select the list item based on the index. Negative operand means - * end-based indexing. + * end-based indexing (-2, ...), and -1 means out of range. */ if (opnd < -1) { @@ -5649,7 +5649,9 @@ TEBCresume( * Adjust indices for end-based indexing. */ - if (fromIdx < -1) { + if (fromIdx == -1) { + fromIdx = 0; + } else if (fromIdx < -1) { fromIdx += 1 + length; if (fromIdx < 0) { fromIdx = 0; diff --git a/tests/lindex.test b/tests/lindex.test index b86e2e0..e513b62 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -79,6 +79,15 @@ test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] } {2147483646 {} 2147483647 2147483648} +test lindex-3.8 {compiled with static indices out of range, negative} { + list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3] +} [lrepeat 3 {}] +test lindex-3.9 {compiled with calculated indices out of range, negative constant} { + list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1] +} [lrepeat 3 {}] +test lindex-3.10 {compiled with calculated indices out of range, after end} { + list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3] +} [lrepeat 3 {}] # Indices relative to end diff --git a/tests/lrange.test b/tests/lrange.test index 17a757e..ba10354 100644 --- a/tests/lrange.test +++ b/tests/lrange.test @@ -90,6 +90,24 @@ test lrange-3.1 {Bug 3588366: end-offsets before start} { lrange $l 0 end-5 }} {1 2 3 4 5} } {} + +test lrange-3.2 {compiled with static indices out of range, negative} { + list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3] +} [lrepeat 4 {}] +test lrange-3.3 {compiled with calculated indices out of range, negative constant} { + list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1] +} [lrepeat 4 {}] +test lrange-3.4 {compiled with calculated indices out of range, after end} { + list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2] +} [lrepeat 4 {}] + +test lrange-3.5 {compiled with calculated indices, start out of range (negative)} { + list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1] +} [lrepeat 4 {a b}] +test lrange-3.6 {compiled with calculated indices, end out of range (after end)} { + list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1] +} [lrepeat 4 {b c}] + # cleanup ::tcltest::cleanupTests -- cgit v0.12