Merge 8.7

6 files changed, 33 insertions, 22 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 147c2dc..817416a 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2673,7 +2673,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/tclEncoding.c b/generic/tclEncoding.c
index d10d9ca..ca96057 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -3199,7 +3199,7 @@ TableFromUtfProc(
 	    word = fromUnicode[(ch >> 8)][ch & 0xFF];
 
 	if ((word == 0) && (ch != 0)) {
-	    if ((STOPONERROR) && (flags & TCL_ENCODING_CHAR_LIMIT)) {
+	    if (STOPONERROR) {
 		result = TCL_CONVERT_UNKNOWN;
 		break;
 	    }
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 25bf34b..723d2e5 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3859,9 +3859,10 @@ TclStringCmp(
     Tcl_Obj *value2Ptr,
     int checkEq,		/* comparison is only for equality */
     int nocase,			/* comparison is not case sensitive */
-    int reqlength)		/* requested length */
+    int reqlength)		/* requested length in characters;
+						 * TCL_INDEX_NONE to compare whole strings */
 {
-    char *s1, *s2;
+    const char *s1, *s2;
     int empty, length, match, s1len, s2len;
     memCmpFn_t memCmpFn;
 
@@ -3886,10 +3887,10 @@ TclStringCmp(
 	} else if (TclHasInternalRep(value1Ptr, &tclUniCharStringType)
 		&& TclHasInternalRep(value2Ptr, &tclUniCharStringType)) {
 	    /*
-	     * 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) {
@@ -3903,6 +3904,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;
@@ -3919,6 +3923,9 @@ TclStringCmp(
 			memCmpFn = memcmp;
 			s1len *= sizeof(Tcl_UniChar);
 			s2len *= sizeof(Tcl_UniChar);
+			if (reqlength > 0) {
+			    reqlength *= sizeof(Tcl_UniChar);
+			}
 		    } else {
 			memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
 		    }
@@ -3960,7 +3967,7 @@ TclStringCmp(
 		s1 = TclGetStringFromObj(value1Ptr, &s1len);
 		s2 = TclGetStringFromObj(value2Ptr, &s2len);
 	    }
-	    if (!nocase && checkEq) {
+	    if (!nocase && checkEq && reqlength < 0) {
 		/*
 		 * When we have equal-length we can check only for
 		 * (in)equality. We can use memcmp in all (n)eq cases because
@@ -3988,19 +3995,23 @@ 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 > 0 && reqlength < length) {
 	    length = reqlength;
 	} else if (reqlength < 0) {
 	    /*
-	     * 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;
 	}
 
-	if (checkEq && (s1len != s2len)) {
+	if (checkEq && reqlength < 0 && (s1len != s2len)) {
 	    match = 1;		/* This will be reversed below. */
 	} else {
 	    /*
diff --git a/tests/chanio.test b/tests/chanio.test
index 2189cc4..6b45da9 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -252,7 +252,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod
 test chan-io-3.4 {WriteChars: loop over stage buffer} -body {
     # stage buffer maps to more than can be queued at once.
     set f [open $path(test1) w]
-    chan configure $f -encoding jis0208 -buffersize 16
+    chan configure $f -encoding jis0208 -buffersize 16 -nocomplainencoding 1
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     chan close $f
@@ -265,7 +265,7 @@ test chan-io-3.5 {WriteChars: saved != 0} -body {
     # be moved to beginning of next channel buffer to preserve requested
     # buffersize.
     set f [open $path(test1) w]
-    chan configure $f -encoding jis0208 -buffersize 17
+    chan configure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     chan close $f
@@ -298,7 +298,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
     # on flush. The truncated bytes are moved to the beginning of the next
     # channel buffer.
     set f [open $path(test1) w]
-    chan configure $f -encoding jis0208 -buffersize 17
+    chan configure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     chan close $f
diff --git a/tests/io.test b/tests/io.test
index d10e1e4..d2e687d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -272,7 +272,7 @@ test io-3.4 {WriteChars: loop over stage buffer} -body {
     # stage buffer maps to more than can be queued at once.
 
     set f [open $path(test1) w]
-    fconfigure $f -encoding jis0208 -buffersize 16
+    fconfigure $f -encoding jis0208 -buffersize 16 -nocomplainencoding 1
     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     close $f
@@ -286,7 +286,7 @@ test io-3.5 {WriteChars: saved != 0} -body {
     # requested buffersize.
 
     set f [open $path(test1) w]
-    fconfigure $f -encoding jis0208 -buffersize 17
+    fconfigure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     close $f
@@ -319,7 +319,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
     # of the next channel buffer.
 
     set f [open $path(test1) w]
-    fconfigure $f -encoding jis0208 -buffersize 17
+    fconfigure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     close $f
diff --git a/tests/string.test b/tests/string.test
index 6623f04..ade673e 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -134,7 +134,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" "@"}
@@ -198,10 +198,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} {
@@ -289,7 +289,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" "@"}