From 332401e6453aa9e5621de6fa085169ca2ce51c8c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Nov 2019 12:27:00 +0000 Subject: Add some new test-cases involving e.g. Unicode 11. Backported from Tcl 8.7a3 --- tests/utf.test | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/tests/utf.test b/tests/utf.test index 95775a8..c43d95a 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -44,6 +44,18 @@ test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints {fullutf testbytestring} -body { expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]} } -result 1 +test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { + expr {"\ud842" eq [testbytestring "\xed\xa1\x82"]} +} 1 +test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { + expr {"\udc42" eq [testbytestring "\xed\xb1\x82"]} +} 1 +test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { + expr {[format %c 0xd842] eq [testbytestring "\xed\xa1\x82"]} +} 1 +test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { + expr {[format %c 0xdc42] eq [testbytestring "\xed\xb1\x82"]} +} 1 test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" @@ -96,7 +108,7 @@ test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC2\xA2"] } {1} test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] + testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] } {7} test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC0\x80"] @@ -108,7 +120,7 @@ test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestri testnumutfchars [testbytestring "\xC2\xA2"] 2 } {1} test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 10 + testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] 10 } {7} test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC0\x80"] 2 @@ -250,6 +262,9 @@ test utf-11.3 {Tcl_UtfToUpper} { test utf-11.4 {Tcl_UtfToUpper} { string toupper \u01e3ab } \u01e2AB +test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} { + string toupper \u10d0\u1c90 +} \u1c90\u1c90 test utf-12.1 {Tcl_UtfToLower} { string tolower {} @@ -263,6 +278,9 @@ test utf-12.3 {Tcl_UtfToLower} { test utf-12.4 {Tcl_UtfToLower} { string tolower \u01e2AB } \u01e3ab +test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { + string tolower \u10d0\u1c90 +} \u10d0\u10d0 test utf-13.1 {Tcl_UtfToTitle} { string totitle {} @@ -276,6 +294,12 @@ test utf-13.3 {Tcl_UtfToTitle} { test utf-13.4 {Tcl_UtfToTitle} { string totitle \u01f3ab } \u01f2ab +test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { + string totitle \u10d0\u1c90 +} \u10d0\u1c90 +test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { + string totitle \u1c90\u10d0 +} \u1c90\u10d0 test utf-14.1 {Tcl_UtfNcasecmp} { string compare -nocase a b -- cgit v0.12 From 3435c9713f7b20d9061a5b2758728e66846c8989 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 1 Dec 2019 11:59:41 +0000 Subject: add tcltest::SetupTest to make it easier to customize the -setup step of a test --- library/tcltest/tcltest.tcl | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index a7a68c7..2d36d13 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1983,7 +1983,8 @@ proc tcltest::test {name description args} { } # First, run the setup script - set code [catch {uplevel 1 $setup} setupMsg] + lassign [uplevel 1 [list [ + namespace which SetupScript] $setup]] code setupMsg if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup) $::errorCode @@ -2338,6 +2339,8 @@ proc tcltest::Skipped {name constraints} { return 0 } + + # RunTest -- # # This is where the body of a test is evaluated. The combination of @@ -2359,6 +2362,19 @@ proc tcltest::RunTest {name script} { return [list $actualAnswer $code] } + + +# SetupTest -- +# +# Evaluates the -setup script for a test + +proc tcltest::SetupTest {name script} { + DebugPuts 3 [list Setup Script for $name $script] + + set code [catch {uplevel 1 $setup} setupMsg] + return [list $code $setupMsg] +} + ##################################################################### # tcltest::cleanupTestsHook -- -- cgit v0.12 From d138d28133e65fbabfecdf4ed817196b81debc81 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 1 Dec 2019 13:48:48 +0000 Subject: Fix tcltest::SetupTest added in previous commit. --- library/tcltest/tcltest.tcl | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 2d36d13..820e978 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1983,8 +1983,9 @@ proc tcltest::test {name description args} { } # First, run the setup script - lassign [uplevel 1 [list [ - namespace which SetupScript] $setup]] code setupMsg + set code [catch { + uplevel 1 [list [namespace which SetupTest] $setup] + } setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup) $::errorCode @@ -2368,11 +2369,8 @@ proc tcltest::RunTest {name script} { # # Evaluates the -setup script for a test -proc tcltest::SetupTest {name script} { - DebugPuts 3 [list Setup Script for $name $script] - - set code [catch {uplevel 1 $setup} setupMsg] - return [list $code $setupMsg] +proc tcltest::SetupTest setup { + uplevel 1 $setup } ##################################################################### -- cgit v0.12