summaryrefslogtreecommitdiffstats
path: root/tests/utf.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/utf.test')
-rw-r--r--tests/utf.test200
1 files changed, 147 insertions, 53 deletions
diff --git a/tests/utf.test b/tests/utf.test
index 56a3acb..ebab967 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -7,14 +7,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: utf.test,v 1.12 2003/10/08 15:24:21 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
catch {unset x}
test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} {
@@ -29,6 +30,12 @@ test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} {
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} {
set x "\u4e4e"
} [bytestring "\xe4\xb9\x8e"]
+test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} {
+ format %c 0x110000
+} [bytestring "\xef\xbf\xbd"]
+test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} {
+ format %c -1
+} [bytestring "\xef\xbf\xbd"]
test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
@@ -167,7 +174,7 @@ bsCheck \x 120
bsCheck \xa 10
bsCheck \xA 10
bsCheck \x41 65
-bsCheck \x541 65
+bsCheck \x541 84
bsCheck \u 117
bsCheck \uk 117
bsCheck \u41 65
@@ -176,6 +183,18 @@ bsCheck \uA 10
bsCheck \340 224
bsCheck \ua1 161
bsCheck \u4e21 20001
+bsCheck \741 60
+bsCheck \U 85
+bsCheck \Uk 85
+bsCheck \U41 65
+bsCheck \Ua 10
+bsCheck \UA 10
+bsCheck \Ua1 161
+bsCheck \U4e21 20001
+bsCheck \U004e21 20001
+bsCheck \U00004e21 20001
+bsCheck \U00110000 65533
+bsCheck \Uffffffff 65533
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
@@ -243,8 +262,9 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} {
string tolower aA
} aa
test utf-16.2 {Tcl_UniCharToLower, positive delta} {
- string tolower \u0178\u00ff
-} \u00ff\u00ff
+ string tolower \u0178\u00ff\uA78D\u01c5
+} \u00ff\u00ff\u0265\u01c6
+
test utf-17.1 {Tcl_UniCharToLower, no delta} {
string tolower !
} !
@@ -273,13 +293,53 @@ test utf-20.1 {TclUniCharNcmp} {
} {}
test utf-21.1 {TclUniCharIsAlnum} {
- # this returns 1 with Unicode 3 compliance
- string is alnum \u1040\u021f
+ # this returns 1 with Unicode 6 compliance
+ string is alnum \u1040\u021f\u0220
} {1}
test utf-21.2 {unicode alnum char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- list [regexp {^[[:alnum:]]+$} \u1040\u021f] [regexp {^\w+$} \u1040\u021f]
+ # this returns 1 with Unicode 6 compliance
+ list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220]
} {1 1}
+test utf-21.3 {unicode print char in regc_locale.c} {
+ # this returns 1 with Unicode 6 compliance
+ regexp {^[[:print:]]+$} \ufbc1
+} 1
+test utf-21.4 {TclUniCharIsGraph} {
+ # [Bug 3464428]
+ string is graph \u0120
+} {1}
+test utf-21.5 {unicode graph char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {^[[:graph:]]+$} \u0120
+} {1}
+test utf-21.6 {TclUniCharIsGraph} {
+ # [Bug 3464428]
+ string is graph \u00a0
+} {0}
+test utf-21.7 {unicode graph char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {[[:graph:]]} \u0020\u00a0\u2028\u2029
+} {0}
+test utf-21.8 {TclUniCharIsPrint} {
+ # [Bug 3464428]
+ string is print \u0009
+} {0}
+test utf-21.9 {unicode print char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {[[:print:]]} \u0009
+} {0}
+test utf-21.10 {unicode print char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {[[:print:]]} \u0009
+} {0}
+test utf-21.11 {TclUniCharIsControl} {
+ # [Bug 3464428]
+ string is control \u00ad
+} {1}
+test utf-21.12 {unicode control char in regc_locale.c} {
+ # [Bug 3464428], [Bug a876646efe]
+ regexp {^[[:cntrl:]]*$} \u0000\u001f\u00ad
+} {1}
test utf-22.1 {TclUniCharIsWordChar} {
string wordend "xyz123_bar fg" 0
@@ -289,66 +349,100 @@ test utf-22.2 {TclUniCharIsWordChar} {
} 10
test utf-23.1 {TclUniCharIsAlpha} {
- # this returns 1 with Unicode 3 compliance
- string is alpha \u021f
+ # this returns 1 with Unicode 6 compliance
+ string is alpha \u021f\u0220
} {1}
test utf-23.2 {unicode alpha char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- regexp {^[[:alpha:]]+$} \u021f
+ # this returns 1 with Unicode 6 compliance
+ regexp {^[[:alpha:]]+$} \u021f\u0220
} {1}
test utf-24.1 {TclUniCharIsDigit} {
- # this returns 1 with Unicode 3 compliance
- string is digit \u1040
+ # this returns 1 with Unicode 6 compliance
+ string is digit \u1040\uabf0
} {1}
test utf-24.2 {unicode digit char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040]
+ # this returns 1 with Unicode 6 compliance
+ list [regexp {^[[:digit:]]+$} \u1040\uabf0] [regexp {^\d+$} \u1040\uabf0]
} {1 1}
test utf-24.3 {TclUniCharIsSpace} {
- # this returns 1 with Unicode 3 compliance
- string is space \u1680
+ # this returns 1 with Unicode 6 compliance
+ string is space \u1680\u180e
} {1}
test utf-24.4 {unicode space char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680]
+ # this returns 1 with Unicode 6 compliance
+ list [regexp {^[[:space:]]+$} \u1680\u180e] [regexp {^\s+$} \u1680\u180e]
} {1 1}
testConstraint teststringobj [llength [info commands teststringobj]]
-test utf-25.1 {Tcl_UniCharNcasecmp} teststringobj {
- testobj freeallvars
- teststringobj set 1 a
- teststringobj set 2 b
- teststringobj getunicode 1
- teststringobj getunicode 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} -1
-test utf-25.2 {Tcl_UniCharNcasecmp} teststringobj {
- testobj freeallvars
- teststringobj set 1 b
- teststringobj set 2 a
- teststringobj getunicode 1
- teststringobj getunicode 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} 1
-test utf-25.3 {Tcl_UniCharNcasecmp} teststringobj {
- testobj freeallvars
- teststringobj set 1 B
- teststringobj set 2 a
- teststringobj getunicode 1
- teststringobj getunicode 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} 1
-test utf-25.4 {Tcl_UniCharNcasecmp} teststringobj {
- testobj freeallvars
- teststringobj set 1 aBcB
- teststringobj set 2 abca
- teststringobj getunicode 1
- teststringobj getunicode 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} 1
+
+test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+ -setup {
+ testobj freeallvars
+ } \
+ -body {
+ teststringobj set 1 a
+ teststringobj set 2 b
+ teststringobj getunicode 1
+ teststringobj getunicode 2
+ string compare -nocase [teststringobj get 1] [teststringobj get 2]
+ } \
+ -cleanup {
+ testobj freeallvars
+ } \
+ -result -1
+test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+ -setup {
+ testobj freeallvars
+ } \
+ -body {
+ teststringobj set 1 b
+ teststringobj set 2 a
+ teststringobj getunicode 1
+ teststringobj getunicode 2
+ string compare -nocase [teststringobj get 1] [teststringobj get 2]
+ } \
+ -cleanup {
+ testobj freeallvars
+ } \
+ -result 1
+test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+ -setup {
+ testobj freeallvars
+ } \
+ -body {
+ teststringobj set 1 B
+ teststringobj set 2 a
+ teststringobj getunicode 1
+ teststringobj getunicode 2
+ string compare -nocase [teststringobj get 1] [teststringobj get 2]
+ } \
+ -cleanup {
+ testobj freeallvars
+ } \
+ -result 1
+
+test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+ -setup {
+ testobj freeallvars
+ } \
+ -body {
+ teststringobj set 1 aBcB
+ teststringobj set 2 abca
+ teststringobj getunicode 1
+ teststringobj getunicode 2
+ string compare -nocase [teststringobj get 1] [teststringobj get 2]
+ } \
+ -cleanup {
+ testobj freeallvars
+ } \
+ -result 1
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
generated by cgit v0.12 at 2025-10-21 21:02:09 (GMT)