From 20c0cdf51c6a9cb24182ba805ea2f0f1e87e0a24 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Nov 2019 15:49:45 +0000 Subject: Fix [d4f5620f5d]: font-4.14 fails (font actual with unicode). Add another test-case for TCL_UTF_MAX>3 --- generic/tkUtil.c | 2 +- tests/font.test | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 33faab8..38f71ea 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1227,7 +1227,7 @@ TkUtfToUniChar( /* This can only happen if Tcl is compiled with TCL_UTF_MAX=4, * or when a high surrogate character is detected in UTF-8 form */ int len2 = Tcl_UtfToUniChar(src+len, &low); - if ((uniChar & 0xFC00) == 0xDC00) { + if ((low & 0xFC00) == 0xDC00) { *chPtr = (((uniChar & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; return len + len2; } diff --git a/tests/font.test b/tests/font.test index 8894d85..c7f1a43 100644 --- a/tests/font.test +++ b/tests/font.test @@ -11,6 +11,8 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# Some tests require support for 4-byte UTF-8 sequences +testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] set defaultfontlist [font names] @@ -152,11 +154,14 @@ test font-4.13 {font command: actual} -body { font actual {-family times} -- \udc00 } -match glob -result {*} test font-4.14 {font command: actual} -constraints win -body { - font actual {-family times} -family -- \ud800\udc00 + font actual {-family times} -family -- \uD800\uDC00 } -result {Times New Roman} test font-4.15 {font command: actual} -body { font actual {-family times} -- \udc00\ud800 } -returnCodes 1 -match glob -result {expected a single character but got "*"} +test font-4.16 {font command: actual} -constraints {fullutf win} -body { + font actual {-family times} -family -- \U10000 +} -result {Times New Roman} test font-5.1 {font command: configure} -body { -- cgit v0.12