1N/A join " ",
map {
sprintf "%04X", $_ }
unpack "U*", $_[
0];
1N/A "lib",
"unicore",
"To"),
1N/A my ($k, $v) =
split(
' ', $i);
1N/A print "# ",
scalar keys %
simple,
" simple mappings\n";
1N/A warn sprintf "$base: $i seen twice\n";
1N/A print "# ",
scalar keys %$
spec,
" special mappings\n";
1N/A for my $i (
map {
ord }
split //,
1N/A "\e !\"#\$%&'()+,-./0123456789:;<=>?\@[\\]^_{|}~\b") {
1N/A next if pack(
"U0U", $i) =~ /\w/;
1N/A print "# ",
scalar keys %
none,
" noncase mappings\n";
1N/A print "1..$tests\n";
1N/A my $c =
pack "U0U",
hex $i;
1N/A "ok $test # $i -> $w\n" :
"not ok $test # $i -> $e ($w)\n";
1N/A my $u =
unpack "U0U", $i;
1N/A my $h =
sprintf "%04X", $u;
1N/A my $c =
chr($u); $c .=
chr(
0x100);
chop $c;
1N/A if (
ord "A" ==
193) {
# EBCDIC 1N/A # We need to a little bit of remapping. 1N/A # For example, in titlecase (ucfirst) mapping 1N/A # of U+0149 the Unicode mapping is U+02BC U+004E. 1N/A # The 4E is N, which in EBCDIC is 2B-- 1N/A # and the ucfirst() does that right. 1N/A # The problem is that our reference 1N/A # data is in Unicode code points. 1N/A # The Right Way here would be to use, say, 1N/A # Encode, to remap the less-than 0x100 code points, 1N/A # but let's try to be Encode-independent here. 1N/A # These are the titlecase exceptions: 1N/A # Unicode Unicode+EBCDIC 1N/A # 0149 -> 02BC 004E (02BC 002B) 1N/A # 01F0 -> 004A 030C (00A2 030C) 1N/A # 1E96 -> 0048 0331 (00E7 0331) 1N/A # 1E97 -> 0054 0308 (00E8 0308) 1N/A # 1E98 -> 0057 030A (00EF 030A) 1N/A # 1E99 -> 0059 030A (00DF 030A) 1N/A # 1E9A -> 0041 02BE (00A0 02BE) 1N/A # The uppercase exceptions are identical. 1N/A # The lowercase has one more: 1N/A # Unicode Unicode+EBCDIC 1N/A # 0130 -> 0069 0307 (00D1 0307) 1N/A if ($i =~ /^(
0130|
0149|
01F0|
1E96|
1E97|
1E98|
1E99|
1E9A)$/) {
1N/A $e =~ s/
004E/
002B/;
# N 1N/A $e =~ s/
0048/
00E7/;
# H 1N/A $e =~ s/
0054/
00E8/;
# T 1N/A # We have to map the output, not the input, because 1N/A # just undo our remapping. 1N/A "ok $test # $i -> $w\n" :
"not ok $test # $h -> $e ($w)\n";
1N/A for my $i (
sort { $a <=> $b }
keys %
none) {
1N/A my $w = $i =
sprintf "%04X", $i;
1N/A my $c =
pack "U0U",
hex $i;
1N/A "ok $test # $i -> $w\n" :
"not ok $test # $i -> $e ($w)\n";