Commit | Line | Data |
---|---|---|
9e55ce06 JH |
1 | BEGIN { |
2 | chdir 't' if -d 't'; | |
3 | @INC = '../lib'; | |
4 | } | |
5 | ||
6 | use File::Spec; | |
7 | ||
8 | my $CF = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, | |
9 | "lib", "unicore"), | |
551b6b6f | 10 | "CaseFolding.txt"); |
9e55ce06 | 11 | |
80bf4fef JH |
12 | use constant EBCDIC => ord 'A' == 193; |
13 | ||
9e55ce06 JH |
14 | if (open(CF, $CF)) { |
15 | my @CF; | |
16 | ||
17 | while (<CF>) { | |
2bbc8d55 SP |
18 | # Skip S since we are going for 'F'ull case folding. I is obsolete starting |
19 | # with Unicode 3.2, but leaving it in does no harm, and allows backward | |
20 | # compatibility | |
ce331809 | 21 | if (/^([0-9A-F]+); ([CFI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) { |
80bf4fef | 22 | next if EBCDIC && hex $1 < 0x100; |
9e55ce06 JH |
23 | push @CF, [$1, $2, $3, $4]; |
24 | } | |
25 | } | |
26 | ||
ce331809 JH |
27 | close(CF); |
28 | ||
9e55ce06 JH |
29 | die qq[$0: failed to find casefoldings from "$CF"\n] unless @CF; |
30 | ||
31 | print "1..", scalar @CF, "\n"; | |
32 | ||
33 | my $i = 0; | |
34 | for my $cf (@CF) { | |
35 | my ($code, $status, $mapping, $name) = @$cf; | |
36 | $i++; | |
37 | my $a = pack("U0U*", hex $code); | |
38 | my $b = pack("U0U*", map { hex } split " ", $mapping); | |
9cd90f7b JH |
39 | my $t0 = ":$a:" =~ /:$a:/ ? 1 : 0; |
40 | my $t1 = ":$a:" =~ /:$a:/i ? 1 : 0; | |
41 | my $t2 = ":$a:" =~ /:[$a]:/ ? 1 : 0; | |
42 | my $t3 = ":$a:" =~ /:[$a]:/i ? 1 : 0; | |
43 | my $t4 = ":$a:" =~ /:$b:/i ? 1 : 0; | |
44 | my $t5 = ":$a:" =~ /:[$b]:/i ? 1 : 0; | |
45 | my $t6 = ":$b:" =~ /:$a:/i ? 1 : 0; | |
46 | my $t7 = ":$b:" =~ /:[$a]:/i ? 1 : 0; | |
47 | print $t0 && $t1 && $t2 && $t3 && $t4 && $t5 && $t6 && $t7 ? | |
48 | "ok $i \# - $code - $name - $mapping - $status\n" : | |
49 | "not ok $i \# - $code - $name - $mapping - $status - $t0 $t1 $t2 $t3 $t4 $t5 $t6 $t7\n"; | |
9e55ce06 JH |
50 | } |
51 | } else { | |
52 | die qq[$0: failed to open "$CF": $!\n]; | |
53 | } |