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 19 if (/^([0-9A-F]+); ([CFI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) { 20 next if EBCDIC && hex $1 < 0x100; 21 push @CF, [$1, $2, $3, $4]; 22 } 23 } 24 25 close(CF); 26 27 die qq[$0: failed to find casefoldings from "$CF"\n] unless @CF; 28 29 print "1..", scalar @CF, "\n"; 30 31 my $i = 0; 32 for my $cf (@CF) { 33 my ($code, $status, $mapping, $name) = @$cf; 34 $i++; 35 my $a = pack("U0U*", hex $code); 36 my $b = pack("U0U*", map { hex } split " ", $mapping); 37 my $t0 = ":$a:" =~ /:$a:/ ? 1 : 0; 38 my $t1 = ":$a:" =~ /:$a:/i ? 1 : 0; 39 my $t2 = ":$a:" =~ /:[$a]:/ ? 1 : 0; 40 my $t3 = ":$a:" =~ /:[$a]:/i ? 1 : 0; 41 my $t4 = ":$a:" =~ /:$b:/i ? 1 : 0; 42 my $t5 = ":$a:" =~ /:[$b]:/i ? 1 : 0; 43 my $t6 = ":$b:" =~ /:$a:/i ? 1 : 0; 44 my $t7 = ":$b:" =~ /:[$a]:/i ? 1 : 0; 45 print $t0 && $t1 && $t2 && $t3 && $t4 && $t5 && $t6 && $t7 ? 46 "ok $i \# - $code - $name - $mapping - $status\n" : 47 "not ok $i \# - $code - $name - $mapping - $status - $t0 $t1 $t2 $t3 $t4 $t5 $t6 $t7\n"; 48 } 49} else { 50 die qq[$0: failed to open "$CF": $!\n]; 51} 52