t/uni/fold.t

   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"),
  10                             "CaseFolding.txt");
  11
  12 use constant EBCDIC => ord 'A' == 193;
  13
  14 if (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 }