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 "CaseFolding.txt"); 11 12use constant EBCDIC => ord 'A' == 193; 13 14if (open(CF, $CF)) { 15 my @CF; 16 17 while (<CF>) { 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 21 if (/^([0-9A-F]+); ([CFI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) { 22 next if EBCDIC && hex $1 < 0x100; 23 push @CF, [$1, $2, $3, $4]; 24 } 25 } 26 27 close(CF); 28 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); 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"; 50 } 51} else { 52 die qq[$0: failed to open "$CF": $!\n]; 53} 54