summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclAssembly.c3
-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/cmdIL.test12
-rw-r--r--tests/lindex.test9
-rw-r--r--tests/lrange.test18
8 files changed, 106 insertions, 20 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index f40d662..02c64bd 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -2258,7 +2258,8 @@ GetListIndexOperand(
Tcl_DecrRefCount(value);
/* Convert to an integer, advance to the next token and return. */
- status = TclGetIndexFromToken(tokenPtr, result);
+ status = TclGetIndexFromToken(tokenPtr, result, TCL_INDEX_OUT_OF_RANGE,
+ TCL_INDEX_OUT_OF_RANGE);
*tokenPtrPtr = TokenAfter(tokenPtr);
if (status == TCL_ERROR && interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%.*s\"",
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index e46d524..2386b6d 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;
}
@@ -1513,6 +1537,12 @@ 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)) {
/*
@@ -1522,6 +1552,11 @@ TclCompileLreplaceCmd(
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 6f0cc8f..bf8c482 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/cmdIL.test b/tests/cmdIL.test
index 23a5f96..7636adc 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -203,6 +203,18 @@ test cmdIL-3.4.1 {SortCompare procedure, -index option} -body {
test cmdIL-3.5 {SortCompare procedure, -index option} -body {
lsort -integer -index 2 {{20 10 13} {15}}
} -returnCodes error -result {element 2 missing from sublist "15"}
+test cmdIL-3.5.1 {SortCompare procedure, -index option (out of range, calculated index)} -body {
+ lsort -index 1+3 {{1 . c} {2 . b} {3 . a}}
+} -returnCodes error -result {element 4 missing from sublist "1 . c"}
+test cmdIL-3.5.2 {SortCompare procedure, -index option (out of range, calculated index)} -body {
+ lsort -index -1-1 {{1 . c} {2 . b} {3 . a}}
+} -returnCodes error -result {element -2 missing from sublist "1 . c"}
+test cmdIL-3.5.3 {SortCompare procedure, -index option (out of range, calculated index)} -body {
+ lsort -index -2 {{1 . c} {2 . b} {3 . a}}
+} -returnCodes error -result {element -2 missing from sublist "1 . c"}
+test cmdIL-3.5.4 {SortCompare procedure, -index option (out of range, calculated index)} -body {
+ lsort -index end-4 {{1 . c} {2 . b} {3 . a}}
+} -returnCodes error -result {element -2 missing from sublist "1 . c"}
test cmdIL-3.6 {SortCompare procedure, -index option} {
lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
} {{3 25 20} {2 5 25} {1 15 30}}
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-09-27 22:23:21 (GMT)