From 3c57d80efed172427e5aafa447365cb61439613c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Jun 2018 15:54:38 +0000 Subject: 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 --- generic/tclParse.c | 12 +++++------- generic/tclStringObj.c | 6 ++++++ generic/tclUtf.c | 7 +++++++ 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 } -- cgit v0.12