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

4 files changed, 65 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;