summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompCmdsGR.c57
-rw-r--r--generic/tclCompCmdsSZ.c15
-rw-r--r--generic/tclCompile.h6
-rw-r--r--generic/tclExecute.c6
-rw-r--r--tests/lindex.test9
-rw-r--r--tests/lrange.test18
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
generated by cgit v0.12 at 2024-11-16 00:25:14 (GMT)