try to fix [db36fa5122]: better compiled variants of several indices-related commands, test-cases extended

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