blob: d4245d7d21b28553145de81af9fbc96187186740 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
# See the file LICENSE for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
tcltest::loadTestedCommands
package require tcl::test
testConstraint teststringobj [llength [info commands teststringobj]]
tcltest::testConstraint haveUnicodeIsCmds [expr {![catch {unicode is lower A}]}]
tcltest::testConstraint haveUnicodeToCmds [expr {![catch {unicode tolower A}]}]
source [file join [file dirname [info script]] ucdUtils.tcl]
namespace eval unicode::test {
namespace path ::tcltests::ucd
# We use teststringobj in below tests as it allows us to create invalid
# code points as well.
test string-is-lower-ucd "string is lower vs UCD" -setup {
set lowerChars [getLowercaseChars]
} -cleanup {
unset -nocomplain lowerChars
} -body {
set mismatches {Lower case mismatches:}
foreach codePoint [lseq 0 $::tcltests::ucd::maxCodepoint] {
set ch [format %c $codePoint]
if {[dict exists $lowerChars $ch] != [string is lower $ch]} {
append mismatches " " U+[format %x $codePoint]
}
}
set mismatches
} -constraints {ucdproperties bug_1ecea011} -result {Lower case mismatches:}
test string-is-lower-outofrange "string is lower out of range" -cleanup {
testobj freeallvars
} -body {
string is lower [teststringobj newunicode 1 0x110000]
} -constraints teststringobj -result 0
test string-is-upper-ucd "string is upper vs UCD" -setup {
set upperChars [getUppercaseChars]
} -cleanup {
unset -nocomplain upperChars
} -body {
set mismatches {Upper case mismatches:}
foreach codePoint [lseq 0 $::tcltests::ucd::maxCodepoint] {
set ch [format %c $codePoint]
if {[dict exists $upperChars $ch] != [string is upper $ch]} {
append mismatches " " U+[format %x $codePoint]
}
}
set mismatches
} -constraints {ucdproperties bug_1ecea011} -result {Upper case mismatches:}
test string-is-upper-outofrange "string is upper out of range" -cleanup {
testobj freeallvars
} -body {
string is upper [teststringobj newunicode 1 0x110000]
} -constraints teststringobj -result 0
test unicode-is-lower-ucd "unicode is lower vs UCD" -setup {
set lowerChars [getLowercaseChars]
} -cleanup {
unset -nocomplain lowerChars
} -body {
set mismatches {Lower case mismatches:}
foreach codePoint [lseq 0 $::tcltests::ucd::maxCodepoint] {
set ch [format %c $codePoint]
if {[dict exists $lowerChars $ch] != [unicode is lower $ch]} {
append mismatches " " U+[format %x $codePoint]
}
}
set mismatches
} -constraints {ucdproperties haveUnicodeIsCmds bug_1ecea011} -result {Lower case mismatches:}
test unicode-is-lower-outofrange "unicode is lower out of range" -cleanup {
testobj freeallvars
} -body {
unicode is lower [teststringobj newunicode 1 0x110000]
} -constraints {ucdproperties haveUnicodeIsCmds bug_1ecea011} -result 0
test unicode-is-upper-ucd "unicode is upper vs UCD" -setup {
set upperChars [getUppercaseChars]
} -cleanup {
unset -nocomplain upperChars
} -body {
set mismatches {Upper case mismatches:}
foreach codePoint [lseq 0 1+$::tcltests::ucd::maxCodepoint] {
set ch [format %c $codePoint]
if {[dict exists $upperChars $ch] != [unicode is upper $ch]} {
append mismatches " " U+[format %x $codePoint]
}
}
set mismatches
} -constraints {ucdproperties haveUnicodeIsCmds bug_1ecea011} -result {Upper case mismatches:}
test unicode-is-upper-outofrange "unicode is upper out of range" -cleanup {
testobj freeallvars
} -body {
unicode is upper [teststringobj newunicode 1 0x110000]
} -constraints {haveUnicodeIsCmds teststringobj} -result 0
###
# Compatibility tests between the string and unicode commands.
proc testStringUnicodeCompatibility {class} {
set mismatches "is $class mismatches:"
foreach codePoint [lseq 0 $::tcltests::ucd::maxCodepoint] {
set ch [format %c $codePoint]
if {[string is $class $ch] != [unicode is $class $ch]} {
append mismatches " " U+[format %x $codePoint]
}
}
return $mismatches
}
foreach class {alpha alnum control digit graph lower print space upper wordchar} {
test string-vs-unicode-is-$class "string is $class vs unicode" -body {
testStringUnicodeCompatibility $class
} -constraints haveUnicodeIsCmds -result "is $class mismatches:"
}
proc testStringUnicodeCaseConvertCompatibility {tocase} {
set mismatches "$tocase mismatches:"
foreach codePoint [lseq 0 $::tcltests::ucd::maxCodepoint] {
set ch [format %c $codePoint]
if {[string $tocase $ch] != [unicode $tocase $ch]} {
append mismatches " " U+[format %x $codePoint]
break
}
}
return $mismatches
}
foreach tocase {tolower toupper totitle} {
test string-vs-unicode-$tocase "string $tocase vs unicode" -body {
testStringUnicodeCaseConvertCompatibility $tocase
} -constraints haveUnicodeToCmds -result "$tocase mismatches:"
}
}
::tcltest::cleanupTests
namespace delete unicode::test
return
|
