# 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::*
}
source [file join [file dirname [info script]] ucdUtils.tcl]
namespace eval unicode::test {
namespace path ::tcltests::ucd
variable singleFormChar
variable testCase
variable normForm
variable normEnums; # Matches Tcl_UnicodeNormalizationForm enums
array set normEnums {
nfc 0
nfd 1
nfkc 2
nfkd 3
}
variable profileFlags; # Match TCL_ENCODING_PROFILE_* C flags
array set profileFlags {
strict 0x00000000
tcl8 0x01000000
replace 0x02000000
}
variable bytes
proc hexListToChars {s} {
# 0044 030c -> \u0044\u030c
subst -novariables -nocommands \\U[join $s \\U]
}
# Standard arg number tests
test unicode-badargs-0 {unicode no args} -returnCodes error -body {
unicode
} -result {wrong # args: should be "unicode subcommand ?arg ...?"}
test unicode-badargs-1 {unicode bad command} -returnCodes error -body {
unicode foo
} -result {unknown or ambiguous subcommand "foo": must be category, is, tonfc, tonfd, tonfkc, or tonfkd}
variable cmd
foreach cmd {tonfc tonfd tonfkc tonfkd} {
test $cmd-badargs-0 "$cmd 0 args" -returnCodes error -body {
unicode $cmd
} -result "wrong # args: should be \"unicode $cmd ?-profile PROFILE? STRING\""
test $cmd-badargs-1 "$cmd 2 args" -returnCodes error -body {
unicode $cmd -profile strict
} -result "wrong # args: should be \"unicode $cmd ?-profile PROFILE? STRING\""
test $cmd-badargs-2 "$cmd extra args" -returnCodes error -body {
unicode $cmd -profile strict foo extra
} -result "wrong # args: should be \"unicode $cmd ?-profile PROFILE? STRING\""
}
# Test generation for nfc, nfd, nfkc, nfkd
foreach testCase [getNormalizationData] {
lassign $testCase lineno chars nfc nfd nfkc nfkd
test tonfc-line-$lineno \
"Test case for NFC at line $lineno of $::tcltests::ucd::normalizationDataFile" \
-constraints ucdnormalization \
-body {
# See Comments in NormalizationTest.txt for expected behaviours
list \
[string equal $nfc [unicode tonfc $chars]] \
[string equal $nfc [unicode tonfc $nfc]] \
[string equal $nfc [unicode tonfc $nfd]] \
[string equal $nfkc [unicode tonfc $nfkc]] \
[string equal $nfkc [unicode tonfc $nfkd]]
} -result {1 1 1 1 1}
test tonfd-line-$lineno \
"Test case for NFD at line $lineno of $::tcltests::ucd::normalizationDataFile" \
-constraints ucdnormalization \
-setup {
readNormalizationData
} -body {
# See Comments in NormalizationTest.txt for expected behaviours
list \
[string equal $nfd [unicode tonfd $chars]] \
[string equal $nfd [unicode tonfd $nfc]] \
[string equal $nfd [unicode tonfd $nfd]] \
[string equal $nfkd [unicode tonfd $nfkc]] \
[string equal $nfkd [unicode tonfd $nfkd]]
} -result {1 1 1 1 1}
test tonfkc-line-$lineno \
"Test case for NFKC at line $lineno of $::tcltests::ucd::normalizationDataFile" \
-constraints ucdnormalization \
-setup {
readNormalizationData
} -body {
# See Comments in NormalizationTest.txt for expected behaviours
list \
[string equal $nfkc [unicode tonfkc $chars]] \
[string equal $nfkc [unicode tonfkc $nfc]] \
[string equal $nfkc [unicode tonfkc $nfd]] \
[string equal $nfkc [unicode tonfkc $nfkc]] \
[string equal $nfkc [unicode tonfkc $nfkd]]
} -result {1 1 1 1 1}
test tonfkd-line-$lineno \
"Test case for NFKD at line $lineno of $::tcltests::ucd::normalizationDataFile" \
-constraints ucdnormalization \
-setup {
readNormalizationData
} -body {
# See Comments in NormalizationTest.txt for expected behaviours
list \
[string equal $nfkd [unicode tonfkd $chars]] \
[string equal $nfkd [unicode tonfkd $nfc]] \
[string equal $nfkd [unicode tonfkd $nfd]] \
[string equal $nfkd [unicode tonfkd $nfkc]] \
[string equal $nfkd [unicode tonfkd $nfkd]]
} -result {1 1 1 1 1}
}
# Each single form character should map to itself for all forms
test normalize-singleform-0 "Normalize single form characters" \
-constraints ucdnormalization \
-body {
lmap singleFormChar [getSingleFormChars] {
if {[tcl::mathop::eq \
$singleFormChar \
[unicode tonfc $singleFormChar] \
[unicode tonfd $singleFormChar] \
[unicode tonfkc $singleFormChar] \
[unicode tonfkd $singleFormChar] \
]} {
continue
}
set singleFormChar
}
} -result {}
# Test generation for casefolding
if {[tcltest::testConstraint ucdcasefolding]} {
foreach testCase [getCaseFoldData] {
lassign $testCase lineno chars casefoldedchars
set id [format %.6X [scan $chars %c]]
test normalize-line-$lineno-$id-nfccasefold \
"Test case for NFC_CaseFold at line $lineno of $::tcltests::ucd::caseFoldDataFile" \
-constraints ucdcasefolding \
-body {
# puts [codepoints $chars]->[codepoints $casefoldedchars]
# See Comments in DerivedNormalizationProps.txt for expected behaviours
toNFKC_Casefold $chars
} -result $casefoldedchars
}
# Characters that should case fold to themselves
proc codepoints {s} {join [lmap c [split $s ""] {
string cat U+ [format %.6X [scan $c %c]]}]
}
test normalize-casefold-identities-0 \
"NFKC Case fold chars mapping to themselves" \
-constraints ucdcasefolding \
-body {
lmap char [caseFoldIdentities] {
if {$char eq [toNFKC_Casefold $char]} {
continue
}
# puts [codepoints $char]
# puts [codepoints [toNFKC_Casefold $char]]
set char
}
} -result {}
}
# Profiles
test tonfc-profile-default-0 "tonfc -profile default success" -body {
unicode tonfc \u1e0a\u031b\u0323
} -result \u1e0c\u031b\u0307
test tonfc-profile-default-1 "tonfc -profile default fail" -body {
unicode tonfc \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfc-profile-strict-0 "tonfc -profile strict success" -body {
unicode tonfc -profile strict \u1e0a\u031b\u0323
} -result \u1e0c\u031b\u0307
test tonfc-profile-strict-1 "tonfc -profile strict fail" -body {
unicode tonfc -profile strict \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfc-profile-replace-0 "tonfc -profile replace success" -body {
unicode tonfc -profile replace \u1e0a\u031b\u0323
} -result \u1e0c\u031b\u0307
test tonfc-profile-replace-1 "tonfc -profile replace fail" -body {
unicode tonfc -profile replace \ud800
} -result \uFFFD
test tonfc-profile-tcl8-0 "tonfc -profile tcl8" -returnCodes error -body {
unicode tonfc -profile tcl8 x
} -result {Invalid value "tcl8" supplied for option "-profile". Must be "strict" or "replace".}
test tonfd-profile-default-0 "tonfd -profile default success" -body {
unicode tonfd \u1E0A\u031B\u0323
} -result \u0044\u031B\u0323\u0307
test tonfd-profile-default-1 "tonfd -profile default fail" -body {
unicode tonfd \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfd-profile-strict-0 "tonfd -profile strict success" -body {
unicode tonfd -profile strict \u1E0A\u031B\u0323
} -result \u0044\u031B\u0323\u0307
test tonfd-profile-strict-1 "tonfd -profile strict fail" -body {
unicode tonfd -profile strict \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfd-profile-replace-0 "tonfd -profile replace success" -body {
unicode tonfd -profile replace \u1E0A\u031B\u0323
} -result \u0044\u031B\u0323\u0307
test tonfd-profile-replace-1 "tonfd -profile replace fail" -body {
unicode tonfd -profile replace \ud800
} -result \uFFFD
test tonfd-profile-tcl8-0 "tonfd -profile tcl8" -returnCodes error -body {
unicode tonfd -profile tcl8 x
} -result {Invalid value "tcl8" supplied for option "-profile". Must be "strict" or "replace".}
test tonfkc-profile-default-0 "tonfkc -profile default success" -body {
unicode tonfkc \u01C4\u0323
} -result \u0044\u1E92\u030C
test tonfkc-profile-default-1 "tonfkc -profile default fail" -body {
unicode tonfkc \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfkc-profile-strict-0 "tonfkc -profile strict success" -body {
unicode tonfkc -profile strict \u01C4\u0323
} -result \u0044\u1E92\u030C
test tonfkc-profile-strict-1 "tonfkc -profile strict fail" -body {
unicode tonfkc -profile strict \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfkc-profile-replace-0 "tonfkc -profile replace success" -body {
unicode tonfkc -profile replace \u01C4\u0323
} -result \u0044\u1E92\u030C
test tonfkc-profile-replace-1 "tonfkc -profile replace fail" -body {
unicode tonfkc -profile replace \ud800
} -result \uFFFD
test tonfkc-profile-tcl8-0 "tonfkc -profile tcl8" -returnCodes error -body {
unicode tonfkc -profile tcl8 x
} -result {Invalid value "tcl8" supplied for option "-profile". Must be "strict" or "replace".}
test tonfkd-profile-default-0 "tonfkd -profile default success" -body {
unicode tonfkd \u01C4\u0323
} -result \u0044\u005A\u0323\u030C
test tonfkd-profile-default-1 "tonfkd -profile default fail" -body {
unicode tonfkd \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfkd-profile-strict-0 "tonfkd -profile strict success" -body {
unicode tonfkd -profile strict \u01C4\u0323
} -result \u0044\u005A\u0323\u030C
test tonfkd-profile-strict-1 "tonfkd -profile strict fail" -body {
unicode tonfkd -profile strict \ud800
} -result {unexpected character at index 0: 'U+00D800'} -returnCodes error
test tonfkd-profile-replace-0 "tonfkd -profile replace success" -body {
unicode tonfkd -profile replace \u01C4\u0323
} -result \u0044\u005A\u0323\u030C
test tonfkd-profile-replace-1 "tonfkd -profile replace fail" -body {
unicode tonfkd -profile replace \ud800
} -result \uFFFD
test tonfkd-profile-tcl8-0 "tonfkd -profile tcl8" -returnCodes error -body {
unicode tonfkd -profile tcl8 x
} -result {Invalid value "tcl8" supplied for option "-profile". Must be "strict" or "replace".}
# Tcl_UtfToNormalizedDString C API
foreach testCase [getNormalizationData] {
lassign $testCase lineno chars nfc nfd nfkc nfkd
set bytes [teststringbytes $chars]
foreach profile {strict replace} {
foreach normForm {nfc nfd nfkc nfkd} {
test Tcl_UtfToNormalizedDString-$normForm-line-$lineno-$profile \
"Tcl_UtfToNormalizedDString for $normForm at line $lineno of $::tcltests::ucd::normalizationDataFile" \
-body {
testutfnormalize $bytes $normEnums($normForm) $profileFlags($profile)
} -result [teststringbytes [set $normForm]]
}
}
}
foreach normForm {nfc nfd nfkc nfkd} {
test Tcl_UtfToNormalizedDString-$normForm-nulchar-$profile \
"Tcl_UtfToNormalizedDString for $normForm passed nul character" \
-body {
testutfnormalize [teststringbytes \0] $normEnums($normForm) $profileFlags($profile)
} -result \xC0\x80
}
# Tcl_UtfToNormalizedDString error cases
foreach normForm {nfc nfd nfkc nfkd} {
test Tcl_UtfToNormalizedDString-$normForm-tcl8 \
"Tcl_UtfToNormalizedDString for $normForm profile tcl8" \
-body {
testutfnormalize abc $normEnums($normForm) $profileFlags(tcl8)
} -result {Invalid value 16777216 passed for encoding profile.} -returnCodes error
if {0} {
# TODO - currently, Tcl "fixes up" any internal invalid UTF-8 so
# no way to test normalization of invalid UTF-8. Enable this test
# once this "fixing up" by Tcl is corrected (see Bug [b69e00ecf6])
test Tcl_UtfToNormalizedDString-$normForm-invalid-utf8 \
"Tcl_UtfToNormalizedDString for $normForm invalid utf8 profile strict" \
-body {
testutfnormalize [binary decode hex EFBF7F] $normEnums($normForm) $profileFlags(strict)
} -result {} -returnCodes error
}
}
test Tcl_UtfToNormalizedDString-invalid-normalization-form \
"Tcl_UtfToNormalizedDString invalid value for normalization form" \
-body {
testutfnormalize abc 4 $profileFlags(strict)
} -result {Invalid value 4 passed for normalization form.} -returnCodes error
}
::tcltest::cleanupTests
namespace delete unicode::test
return