Merge 8.7, and make all test-cases pass.

4 files changed, 61 insertions, 22 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 11a6661..02eabe0 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1338,6 +1338,9 @@ StringFirstCmd(
 	    return TCL_ERROR;
 	}
     }
+    if (start < -1) {
+	start = -1;
+    }
     Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(TclStringFirst(objv[1],
 	    objv[2], start)));
     return TCL_OK;
@@ -1383,6 +1386,9 @@ StringLastCmd(
 	    return TCL_ERROR;
 	}
     }
+    if (last < -1) {
+	last = -1;
+    }
     Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(TclStringLast(objv[1],
 	    objv[2], last)));
     return TCL_OK;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ee84560..eb34f29 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4525,6 +4525,7 @@ TEBCresume(
     {
 	int index, numIndices, fromIdx, toIdx;
 	int nocase, match, length2, cflags, s1len, s2len;
+	size_t slength;
 	const char *s1, *s2;
 
     case INST_LIST:
@@ -5246,19 +5247,19 @@ TEBCresume(
 	NEXT_INST_V(1, 3, 1);
 
     case INST_STR_FIND:
-	match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
+	slength = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
 
-	TRACE(("%.20s %.20s => %d\n",
-		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-	TclNewIntObj(objResultPtr, match);
+	TRACE(("%.20s %.20s => %" TCL_Z_MODIFIER "d\n",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), slength));
+	objResultPtr = TclNewWideIntObjFromSize(slength);
 	NEXT_INST_F(1, 2, 1);
 
     case INST_STR_FIND_LAST:
-	match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
+	slength = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, (size_t)-2);
 
-	TRACE(("%.20s %.20s => %d\n",
-		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-	TclNewIntObj(objResultPtr, match);
+	TRACE(("%.20s %.20s => %" TCL_Z_MODIFIER "d\n",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), slength));
+	objResultPtr = TclNewWideIntObjFromSize(slength);
 	NEXT_INST_F(1, 2, 1);
 
     case INST_STR_CLASS:
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 5b51ca5..4ca7b62 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3471,7 +3471,7 @@ TclStringFirst(
 	/* We don't find empty substrings.  Bizarre!
 	 * Whenever this routine is turned into a proper substring
 	 * finder, change to `return start` after limits imposed. */
-	return -1;
+	return TCL_IO_FAILURE;
     }
 
     if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
@@ -3480,6 +3480,10 @@ TclStringFirst(
 
 	/* Find bytes in bytes */
 	bh = TclGetByteArrayFromObj(haystack, &lh);
+	if ((lh < ln) || (start > lh - ln)) {
+	    /* Don't start the loop if there cannot be a valid answer */
+	    return TCL_IO_FAILURE;
+	}
 	end = bh + lh;
 
 	try = bh + start;
@@ -3492,7 +3496,7 @@ TclStringFirst(
 	    try = memchr(try, bn[0], (end + 1 - ln) - try);
 	    if (try == NULL) {
 		/* Leading byte not found -> needle cannot be found. */
-		return -1;
+		return TCL_IO_FAILURE;
 	    }
 	    /* Leading byte found, check rest of needle. */
 	    if (0 == memcmp(try+1, bn+1, ln-1)) {
@@ -3502,7 +3506,7 @@ TclStringFirst(
 	    /* Rest of needle match failed; Iterate to continue search. */
 	    try++;
 	}
-	return -1;
+	return TCL_IO_FAILURE;
     }
 
     /*
@@ -3522,6 +3526,10 @@ TclStringFirst(
 	Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln);
 
 	uh = TclGetUnicodeFromObj(haystack, &lh);
+	if ((lh < ln) || (start > lh - ln)) {
+	    /* Don't start the loop if there cannot be a valid answer */
+	    return TCL_IO_FAILURE;
+	}
 	end = uh + lh;
 
 	for (try = uh + start; try + ln <= end; try++) {
@@ -3530,7 +3538,7 @@ TclStringFirst(
 		return (try - uh);
 	    }
 	}
-	return -1;
+	return TCL_IO_FAILURE;
     }
 }
 
@@ -3570,20 +3578,19 @@ TclStringLast(
 	return TCL_IO_FAILURE;
     }
 
-    lh = Tcl_GetCharLength(haystack);
-    if (last >= lh) {
-	last = lh - 1;
-    }
-
-    if (last < ln - 1) {
-	return TCL_IO_FAILURE;
-    }
-
     if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
 	unsigned char *try, *bh = TclGetByteArrayFromObj(haystack, &lh);
 	unsigned char *bn = TclGetByteArrayFromObj(needle, &ln);
 
+	if (last + 1 >= lh + 1) {
+	    last = lh - 1;
+	}
+	if (last + 1 < ln) {
+	    /* Don't start the loop if there cannot be a valid answer */
+	    return TCL_IO_FAILURE;
+	}
 	try = bh + last + 1 - ln;
+
 	while (try >= bh) {
 	    if ((*try == bn[0])
 		    && (0 == memcmp(try+1, bn+1, ln-1))) {
@@ -3591,13 +3598,20 @@ TclStringLast(
 	    }
 	    try--;
 	}
-	return -1;
+	return TCL_IO_FAILURE;
     }
 
     {
 	Tcl_UniChar *try, *uh = TclGetUnicodeFromObj(haystack, &lh);
 	Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln);
 
+	if (last + 1 >= lh + 1) {
+	    last = lh - 1;
+	}
+	if (last + 1 < ln) {
+	    /* Don't start the loop if there cannot be a valid answer */
+	    return TCL_IO_FAILURE;
+	}
 	try = uh + last + 1 - ln;
 	while (try >= uh) {
 	    if ((*try == un[0])
diff --git a/tests/string.test b/tests/string.test
index 9bceb37..fc98629 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -421,6 +421,24 @@ test string-4.16.$noComp {string first, normal string vs pure unicode string} {
     run {list [representationpoke $s] [representationpoke $m] \
 	[string first $m $s]}
 } {{string 1} {string 0} 2}
+test string-4.17.$noComp {string first, corner case} {
+    run {string first a aaa 4294967295}
+} {-1}
+test string-4.18.$noComp {string first, corner case} {
+    run {string first a aaa -1}
+} {0}
+test string-4.19.$noComp {string first, corner case} {
+    run {string first a aaa end-5}
+} {0}
+test string-4.20.$noComp {string last, corner case} {
+    run {string last a aaa 4294967295}
+} {2}
+test string-4.21.$noComp {string last, corner case} {
+    run {string last a aaa -1}
+} {-1}
+test string-4.22.$noComp {string last, corner case} {
+    run {string last a aaa end-5}
+} {-1}
 
 test string-5.1.$noComp {string index} {
     list [catch {run {string index}} msg] $msg