Fix [53cad613d8]: TIP 389 implementation makes Tk tests font-4.12 and font-4.15 fail. One more situation in which high surrogate causes problem

3 files changed, 18 insertions, 7 deletions

diff --git a/generic/tclParse.c b/generic/tclParse.c
index fc7f77b..f26f933 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -991,15 +991,13 @@ TclParseBackslash(
     if (readPtr != NULL) {
 	*readPtr = count;
     }
-#if TCL_UTF_MAX >= 4
-    if ((result & 0xFC00) == 0xD800) {
-	dst[2] = (char) ((result | 0x80) & 0xBF);
-	dst[1] = (char) (((result >> 6) | 0x80) & 0xBF);
-	dst[0] = (char) ((result >> 12) | 0xE0);
-	return 3;
+    count = Tcl_UniCharToUtf(result, dst);
+#if TCL_UTF_MAX > 3
+    if (!count) {
+	count = Tcl_UniCharToUtf(-1, dst);
     }
 #endif
-    return Tcl_UniCharToUtf(result, dst);
+    return count;
 }
 
 /*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index a503392..1795d0c 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1996,6 +1996,12 @@ Tcl_AppendFormatToObj(
 		goto error;
 	    }
 	    length = Tcl_UniCharToUtf(code, buf);
+#if TCL_UTF_MAX > 3
+	    if (!length) {
+		/* Special case for handling upper surrogates. */
+		length = Tcl_UniCharToUtf(-1, buf);
+	    }
+#endif
 	    segment = Tcl_NewStringObj(buf, length);
 	    Tcl_IncrRefCount(segment);
 	    allocSegment = 1;
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 46ce4ef..c2963bf 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -189,6 +189,13 @@ Tcl_UniCharToUtf(
 	    buf[0] = (char) ((ch >> 18) | 0xF0);
 	    return 4;
 	}
+    } else if (ch == -1) {
+	if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
+		&& ((buf[2] & 0xCF) == 0)) {
+	    ch = 0xD7C0 + ((buf[0] & 0x07) << 8) + ((buf[1] & 0x3F) << 2)
+		    + ((buf[2] & 0x30) >> 4);
+	    goto three;
+	}
 #endif
     }