This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Start a new test category: uni. Much of t/op/pat
[perl5.git] / t / uni / fold.t
CommitLineData
9e55ce06
JH
1BEGIN {
2 chdir 't' if -d 't';
3 @INC = '../lib';
4}
5
6use File::Spec;
7
8my $CF = File::Spec->catfile(File::Spec->catdir(File::Spec->updir,
9 "lib", "unicore"),
10 "CaseFold.txt");
11
12if (open(CF, $CF)) {
13 my @CF;
14
15 while (<CF>) {
16 if (/^([0-9A-F]+); ([CFSI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) {
17 next if $2 eq 'S'; # we are going for 'F'ull case folding
18 push @CF, [$1, $2, $3, $4];
19 }
20 }
21
22 die qq[$0: failed to find casefoldings from "$CF"\n] unless @CF;
23
24 print "1..", scalar @CF, "\n";
25
26 my $i = 0;
27 for my $cf (@CF) {
28 my ($code, $status, $mapping, $name) = @$cf;
29 $i++;
30 my $a = pack("U0U*", hex $code);
31 my $b = pack("U0U*", map { hex } split " ", $mapping);
9cd90f7b
JH
32 my $t0 = ":$a:" =~ /:$a:/ ? 1 : 0;
33 my $t1 = ":$a:" =~ /:$a:/i ? 1 : 0;
34 my $t2 = ":$a:" =~ /:[$a]:/ ? 1 : 0;
35 my $t3 = ":$a:" =~ /:[$a]:/i ? 1 : 0;
36 my $t4 = ":$a:" =~ /:$b:/i ? 1 : 0;
37 my $t5 = ":$a:" =~ /:[$b]:/i ? 1 : 0;
38 my $t6 = ":$b:" =~ /:$a:/i ? 1 : 0;
39 my $t7 = ":$b:" =~ /:[$a]:/i ? 1 : 0;
40 print $t0 && $t1 && $t2 && $t3 && $t4 && $t5 && $t6 && $t7 ?
41 "ok $i \# - $code - $name - $mapping - $status\n" :
42 "not ok $i \# - $code - $name - $mapping - $status - $t0 $t1 $t2 $t3 $t4 $t5 $t6 $t7\n";
9e55ce06
JH
43 }
44} else {
45 die qq[$0: failed to open "$CF": $!\n];
46}