Fix "string tolower" and friends for handling unpaired surrogates correctly. Also add test-cases for those situations.

Various typo's in comments.

7 files changed, 49 insertions, 12 deletions

diff --git a/doc/Utf.3 b/doc/Utf.3
index 160575b..922fd81 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -132,7 +132,10 @@ represent one Unicode character in the UTF-8 representation.
 .PP
 \fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
 in starting at \fIbuf\fR.  The return value is the number of bytes stored
-in \fIbuf\fR.
+in \fIbuf\fR. If ch is an upper surrogate (range U+D800 - U+DBFF), then
+the return value will be 0 and nothing will be stored. If you still
+want to produce UTF-8 output for it (even though knowing it's an illegal
+code-point on its own), just call \fBTcl_UniCharToUtf\fR again using ch = -1.
 .PP
 \fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
 and stores it as a Tcl_UniChar in \fI*chPtr\fR.  The return value is the
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d64299e..0bd6cb4 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1447,6 +1447,9 @@ StringIndexCmd(
 	    char buf[4];
 
 	    length = Tcl_UniCharToUtf(ch, buf);
+	    if (!length) {
+		length = Tcl_UniCharToUtf(-1, buf);
+	    }
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
 	}
     }
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index e9aaec4..a0d1258 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -894,7 +894,7 @@ PrintSourceToObj(
 		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
 		i += 10;
 	    } else
-#elif TCL_UTF_MAX > 3
+#else
 	    /* If len == 0, this means we have a char > 0xffff, resulting in
 	     * TclUtfToUniChar producing a surrogate pair. We want to output
 	     * this pair as a single Unicode character.
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fda50b2..82de752 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4964,7 +4964,7 @@ TEBCresume(
 
 	/* Decode index value operands. */
 
-	/* 
+	/*
 	assert ( toIdx != TCL_INDEX_AFTER);
 	 *
 	 * Extra safety for legacy bytecodes:
@@ -5223,9 +5223,15 @@ TEBCresume(
 	     * but creating the object as a string seems to be faster in
 	     * practical use.
 	     */
-
-	    length = (ch != -1) ? Tcl_UniCharToUtf(ch, buf) : 0;
-	    objResultPtr = Tcl_NewStringObj(buf, length);
+	    if (ch == -1) {
+		objResultPtr = Tcl_NewObj();
+	    } else {
+		length = Tcl_UniCharToUtf(ch, buf);
+		if (!length) {
+		    length = Tcl_UniCharToUtf(-1, buf);
+		}
+		objResultPtr = Tcl_NewStringObj(buf, length);
+	    }
 	}
 
 	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 581270c..00b83a1 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -981,6 +981,7 @@ TclParseBackslash(
     }
     count = Tcl_UniCharToUtf(result, dst);
     if (!count) {
+	/* Special case for handling upper surrogates. */
 	count = Tcl_UniCharToUtf(-1, dst);
     }
     return count;
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index ed10ab2..c8292a2 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -218,7 +218,7 @@ Tcl_UniCharToUtfDString(
 {
     const Tcl_UniChar *w, *wEnd;
     char *p, *string;
-    int oldLength;
+    int oldLength, len = 1;
 
     /*
      * UTF-8 string length in bytes will be <= Unicode string length * 4.
@@ -231,9 +231,18 @@ Tcl_UniCharToUtfDString(
     p = string;
     wEnd = uniStr + uniLength;
     for (w = uniStr; w < wEnd; ) {
-	p += Tcl_UniCharToUtf(*w, p);
+	if (!len && ((*w & 0xFC00) != 0xDC00)) {
+	    /* Special case for handling upper surrogates. */
+	    p += Tcl_UniCharToUtf(-1, p);
+	}
+	len = Tcl_UniCharToUtf(*w, p);
+	p += len;
 	w++;
     }
+    if (!len) {
+	/* Special case for handling upper surrogates. */
+	p += Tcl_UniCharToUtf(-1, p);
+    }
     Tcl_DStringSetLength(dsPtr, oldLength + (p - string));
 
     return string;
@@ -899,7 +908,7 @@ Tcl_UtfToUpper(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < TclUtfCount(upChar)) {
+	if ((bytes < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -962,7 +971,7 @@ Tcl_UtfToLower(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < TclUtfCount(lowChar)) {
+	if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -1022,7 +1031,7 @@ Tcl_UtfToTitle(
 #endif
 	titleChar = Tcl_UniCharToTitle(titleChar);
 
-	if (bytes < TclUtfCount(titleChar)) {
+	if ((bytes < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -1046,7 +1055,7 @@ Tcl_UtfToTitle(
 	    lowChar = Tcl_UniCharToLower(lowChar);
 	}
 
-	if (bytes < TclUtfCount(lowChar)) {
+	if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
diff --git a/tests/utf.test b/tests/utf.test
index 67a6778..e820359 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -158,6 +158,12 @@ test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
 test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
     string index \u4e4e\u25a\xff\u543 2
 } "\uff"
+test utf-8.5 {Tcl_UniCharAtIndex: upper surrogate} {
+    string index \ud842 0
+} "\ud842"
+test utf-8.5 {Tcl_UniCharAtIndex: lower surrogate} {
+    string index \udc42 0
+} "\udc42"
 
 test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
     string range abcd 0 2
@@ -263,6 +269,9 @@ test utf-11.4 {Tcl_UtfToUpper} {
 test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
     string toupper \u10d0\u1c90
 } \u1c90\u1c90
+test utf-11.6 {Tcl_UtfToUpper low/high surrogate)} {
+    string toupper \udc24\ud824
+} \udc24\ud824
 
 test utf-12.1 {Tcl_UtfToLower} {
     string tolower {}
@@ -279,6 +288,9 @@ test utf-12.4 {Tcl_UtfToLower} {
 test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
     string tolower \u10d0\u1c90
 } \u10d0\u10d0
+test utf-12.6 {Tcl_UtfToUpper low/high surrogate)} {
+    string tolower \udc24\ud824
+} \udc24\ud824
 
 test utf-13.1 {Tcl_UtfToTitle} {
     string totitle {}
@@ -298,6 +310,9 @@ test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
 test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
     string totitle \u1c90\u10d0
 } \u1c90\u10d0
+test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
+    string totitle \udc24\ud824
+} \udc24\ud824
 
 test utf-14.1 {Tcl_UtfNcasecmp} {
     string compare -nocase a b