Merge 8.7

3 files changed, 26 insertions, 15 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index b559394..f497f59 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2682,7 +2682,7 @@ StringEqualCmd(
      */
 
     objv += objc-2;
-    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
+    match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength);
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
     return TCL_OK;
 }
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 545a1e0..a041d4c 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3468,9 +3468,10 @@ TclStringCmp(
     Tcl_Obj *value2Ptr,
     int checkEq,		/* comparison is only for equality */
     int nocase,			/* comparison is not case sensitive */
-    size_t reqlength)		/* requested length */
+    size_t reqlength)		/* requested length in characters;
+						 * TCL_INDEX_NONE to compare whole strings */
 {
-    char *s1, *s2;
+    const char *s1, *s2;
     int empty, match;
     size_t length, s1len = 0, s2len = 0;
     memCmpFn_t memCmpFn;
@@ -3496,10 +3497,10 @@ TclStringCmp(
 	} else if (TclHasInternalRep(value1Ptr, &tclStringType)
 		&& TclHasInternalRep(value2Ptr, &tclStringType)) {
 	    /*
-	     * Do a unicode-specific comparison if both of the args are of
-	     * String type. If the char length == byte length, we can do a
-	     * memcmp. In benchmark testing this proved the most efficient
-	     * check between the unicode and string comparison operations.
+	     * Do a Unicode-specific comparison if both of the args are of String
+	     * type. If the char length == byte length, we can do a memcmp. In
+	     * benchmark testing this proved the most efficient check between the
+	     * Unicode and string comparison operations.
 	     */
 
 	    if (nocase) {
@@ -3513,6 +3514,9 @@ TclStringCmp(
 			&& (value1Ptr->bytes != NULL)
 			&& (s2len == value2Ptr->length)
 			&& (value2Ptr->bytes != NULL)) {
+			/* each byte represents one character so s1l3n, s2l3n, and
+			 * reqlength are in both bytes and characters
+			 */
 		    s1 = value1Ptr->bytes;
 		    s2 = value2Ptr->bytes;
 		    memCmpFn = memcmp;
@@ -3529,6 +3533,9 @@ TclStringCmp(
 			memCmpFn = memcmp;
 			s1len *= sizeof(Tcl_UniChar);
 			s2len *= sizeof(Tcl_UniChar);
+			if (reqlength != TCL_INDEX_NONE) {
+			    reqlength *= sizeof(Tcl_UniChar);
+			}
 		    } else {
 			memCmpFn = (memCmpFn_t) TclUniCharNcmp;
 		    }
@@ -3570,7 +3577,7 @@ TclStringCmp(
 		s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
 		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
 	    }
-	    if (!nocase && checkEq) {
+	    if (!nocase && checkEq && reqlength == TCL_INDEX_NONE) {
 		/*
 		 * When we have equal-length we can check only for
 		 * (in)equality. We can use memcmp in all (n)eq cases because
@@ -3598,11 +3605,15 @@ TclStringCmp(
 	    }
 	}
 
+	/* At this point s1len, s2len, and reqlength should by now have been
+	 * adjusted so that they are all in the units expected by the selected
+	 * comparison function.
+	 */
 	length = (s1len < s2len) ? s1len : s2len;
 	if (reqlength == TCL_INDEX_NONE) {
 	    /*
-	     * The requested length is negative, so we ignore it by setting it
-	     * to length + 1 so we correct the match var.
+	     * The requested length is negative, so ignore it by setting it
+	     * to length + 1 to correct the match var.
 	     */
 
 	    reqlength = length + 1;
@@ -3610,7 +3621,7 @@ TclStringCmp(
 	    length = reqlength;
 	}
 
-	if (checkEq && (s1len != s2len)) {
+	if (checkEq && reqlength == TCL_INDEX_NONE && (s1len != s2len)) {
 	    match = 1;		/* This will be reversed below. */
 	} else {
 	    /*
diff --git a/tests/string.test b/tests/string.test
index 045d466..7b31f93 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -135,7 +135,7 @@ test string-2.11.3.$noComp {string compare, unicode} {
     run {string compare ÜÜÜüü ÜÜÜÜÜ}
 } 1
 test string-2.12.$noComp {string compare, high bit} {
-    # This test will fail if the underlying comparison
+    # This test fails if the underlying comparison
     # is using signed chars instead of unsigned chars.
     # (like SunOS's default memcmp thus the compat/memcmp.c)
     run {string compare "\x80" "@"}
@@ -199,10 +199,10 @@ test string-2.26.$noComp {string compare -nocase, null strings} {
 test string-2.27.$noComp {string compare -nocase, null strings} {
     run {string compare -nocase foo ""}
 } 1
-test string-2.28.$noComp {string compare with length, unequal strings} {
+test string-2.28.$noComp {string compare with length, unequal strings, partial first string} {
     run {string compare -length 2 abc abde}
 } 0
-test string-2.29.$noComp {string compare with length, unequal strings} {
+test string-2.29.$noComp {string compare with length, unequal strings 2, full first string} {
     run {string compare -length 2 ab abde}
 } 0
 test string-2.30.$noComp {string compare with NUL character vs. other ASCII} {
@@ -290,7 +290,7 @@ test string-3.19.$noComp {string equal, unicode} {
     run {string equal ÜÜÜüü ÜÜÜÜÜ}
 } 0
 test string-3.20.$noComp {string equal, high bit} {
-    # This test will fail if the underlying comparison
+    # This test fails if the underlying comparison
     # is using signed chars instead of unsigned chars.
     # (like SunOS's default memcmp thus the compat/memcmp.c)
     run {string equal "\x80" "@"}