summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/encoding.test20
-rw-r--r--tests/string.test18
-rw-r--r--tests/utf.test38
3 files changed, 56 insertions, 20 deletions
diff --git a/tests/encoding.test b/tests/encoding.test
index a359f76..5b3c3e1 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -34,6 +34,7 @@ proc runtests {} {
# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
+testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
testConstraint exec [llength [info commands exec]]
testConstraint testgetdefenc [llength [info commands testgetdefenc]]
@@ -73,7 +74,7 @@ test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
} -constraints {testencoding} -body {
encoding system shiftjis ;# incr ref count
encoding dirs [list [pwd]]
- set x [encoding convertto shiftjis \u4e4e] ;# old one found
+ set x [encoding convertto shiftjis \u4e4e] ;# old one found
encoding system identity
llength shiftjis ;# Shimmer away any cache of Tcl_Encoding
lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
@@ -182,7 +183,7 @@ test encoding-8.1 {Tcl_ExternalToUtf} {
puts -nonewline $f "ab\x8c\xc1g"
close $f
set f [open [file join [temporaryDirectory] dummy] r]
- fconfigure $f -translation binary -encoding shiftjis
+ fconfigure $f -translation binary -encoding shiftjis
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
@@ -265,7 +266,7 @@ test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding}
makeDirectory tmp
makeDirectory [file join tmp encoding]
set f [open [file join tmp encoding splat.enc] w]
- fconfigure $f -translation binary
+ fconfigure $f -translation binary
puts $f "abcdefghijklmnop"
close $f
encoding convertto splat \u4e4e
@@ -286,11 +287,11 @@ test encoding-12.1 {LoadTableEncoding: normal encoding} {
append x [encoding convertfrom iso8859-3 \xd5]
} "\xd5?\u120"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
- set x [encoding convertto iso8859-3 ab\u0120g]
+ set x [encoding convertto iso8859-3 ab\u0120g]
append x [encoding convertfrom iso8859-3 ab\xd5g]
} "ab\xd5gab\u120g"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
- set x [encoding convertto shiftjis ab\u4e4eg]
+ set x [encoding convertto shiftjis ab\u4e4eg]
append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
@@ -332,9 +333,14 @@ test encoding-16.1 {UnicodeToUtfProc} {
set val [encoding convertfrom unicode NN]
list $val [format %x [scan $val %c]]
} "\u4e4e 4e4e"
+test encoding-16.2 {UnicodeToUtfProc} -constraints fullutf -body {
+ set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"]
+ list $val [format %x [scan $val %c]]
+} -result "\U460dc 460dc"
-test encoding-17.1 {UtfToUnicodeProc} {
-} {}
+test encoding-17.1 {UtfToUnicodeProc} -constraints fullutf -body {
+ encoding convertto unicode "\U460dc"
+} -result "\xd8\xd8\xdc\xdc"
test encoding-18.1 {TableToUtfProc} {
} {}
diff --git a/tests/string.test b/tests/string.test
index 3611753..cc65e67 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -219,7 +219,7 @@ test string-4.14 {string first, negative start index} {
} 1
test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
# Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
- # strings was incorrect, leading to an index returned by [string first]
+ # strings was incorrect, leading to an index returned by [string first]
# which pointed past the end of the string.
set uchar \u057e ;# character with two-byte encoding in utf-8
string first % %#$uchar$uchar#$uchar$uchar#% 3
@@ -419,7 +419,7 @@ test string-6.37 {string is double, false on int overflow} -setup {
} -result {1 priorValue}
# string-6.38 removed, underflow on input is no longer an error.
test string-6.39 {string is double, false} {
- # This test is non-portable because IRIX thinks
+ # This test is non-portable because IRIX thinks
# that .e1 is a valid double - this is really a bug
# on IRIX as .e1 should NOT be a valid double
#
@@ -576,12 +576,12 @@ test string-6.85 {string is control} {
} 0
test string-6.86 {string is graph} {
## graph is any print char, except space
- list [string is gra -fail var "0123abc!@#\$\u0100 "] $var
-} {0 12}
+ list [string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "] $var
+} {0 14}
test string-6.87 {string is print} {
## basically any printable char
- list [string is print -fail var "0123abc!@#\$\u0100 \u0010"] $var
-} {0 13}
+ list [string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"] $var
+} {0 15}
test string-6.88 {string is punct} {
## any graph char that isn't alnum
list [string is punct -fail var "_!@#\u00beq0"] $var
@@ -901,6 +901,10 @@ test string-10.20 {string map, dictionaries don't alter map ordering} {
set map {aa X a Y}
list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
} {XY XY 2 XY}
+test string-10.20.1 {string map, dictionaries don't alter map ordering} {
+ set map {a X b Y a Z}
+ list [string map [dict create a X b Y a Z] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
+} {ZZZ XXX 2 XXX}
test string-10.21 {string map, ABR checks} {
string map {longstring foob} long
} long
@@ -1833,7 +1837,7 @@ proc MemStress {args} {
set res {}
foreach body $args {
set end 0
- for {set i 0} {$i < 5} {incr i} {
+ for {set i 0} {$i < 5} {incr i} {
proc MemStress_Body {} $body
uplevel 1 MemStress_Body
rename MemStress_Body {}
diff --git a/tests/utf.test b/tests/utf.test
index a03dd6c..28981d6 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -20,6 +20,9 @@ testConstraint testbytestring [llength [info commands testbytestring]]
catch {unset x}
+# Some tests require support for 4-byte UTF-8 sequences
+testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
+
test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
expr {"\x01" eq [testbytestring "\x01"]}
} 1
@@ -38,6 +41,9 @@ test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]}
} 1
+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-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
@@ -60,9 +66,21 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestrin
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
string length [testbytestring "\xE4\xb9\x8e"]
} {1}
-test utf-2.8 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring {
- string length [testbytestring "\xF4\xA2\xA2\xA2"]
+test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
+ string length [testbytestring "\xF0\x90\x80\x80"]
+} -result {1}
+test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
+ string length [testbytestring "\xF4\x8F\xBF\xBF"]
+} -result {1}
+test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
+ string length [testbytestring "\xF0\x8F\xBF\xBF"]
+} {4}
+test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring {
+ string length [testbytestring "\xF4\x90\x80\x80"]
} {4}
+test utf-2.12 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring {
+ string length [testbytestring "\xF8\xA2\xA2\xA2\xA2"]
+} {5}
test utf-3.1 {Tcl_UtfCharComplete} {
} {}
@@ -195,8 +213,16 @@ bsCheck \Ua1 161
bsCheck \U4e21 20001
bsCheck \U004e21 20001
bsCheck \U00004e21 20001
-bsCheck \U00110000 65533
-bsCheck \Uffffffff 65533
+bsCheck \U0000004e21 78
+if {[testConstraint fullutf]} {
+ bsCheck \U00110000 69632
+ bsCheck \U01100000 69632
+ bsCheck \U11000000 69632
+ bsCheck \U0010FFFF 1114111
+ bsCheck \U010FFFF0 1114111
+ bsCheck \U10FFFF00 1114111
+ bsCheck \UFFFFFFFF 1048575
+}
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
@@ -264,8 +290,8 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} {
string tolower aA
} aa
test utf-16.2 {Tcl_UniCharToLower, positive delta} {
- string tolower \u0178\u00ff\uA78D\u01c5
-} \u00ff\u00ff\u0265\u01c6
+ string tolower \u0178\u00ff\uA78D\u01c5\U10400
+} \u00ff\u00ff\u0265\u01c6\U10428
test utf-17.1 {Tcl_UniCharToLower, no delta} {
string tolower !
generated by cgit v0.12 at 2024-11-17 08:32:53 (GMT)