t/op/reg_fold.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 my $count=1;
   5 my @tests;
   6 use Cwd;
   7
   8 my $file="../lib/unicore/CaseFolding.txt";
   9 open my $fh,"<",$file
  10     or die "Failed to read '$file' from '".cwd()."': $!";
  11 while (<$fh>) {
  12     chomp;
  13     my ($line,$comment)= split/\s+#\s+/, $_;
  14     my ($cp,$type,@fc)=split/[\s;]+/,$line||'';
  15     next unless $type and ($type eq 'F' or $type eq 'C');
  16     $_="\\x{$_}" for @fc;
  17     my $cpv=hex("0x$cp");
  18     my $chr="chr(0x$cp)";
  19     my @str;
  20     push @str,$chr if $cpv<128 or $cpv>256;
  21     if ($cpv<256) {
  22         push @str,"do{my \$c=$chr; utf8::upgrade(\$c); \$c}"
  23     }
  24
  25     foreach my $str ( @str ) {
  26         my $expr="$str=~/@fc/ix";
  27         my $t=($cpv > 256 || $str=~/^do/) ? "unicode" : "latin";
  28         push @tests,
  29             qq[ok($expr,'$chr=~/@fc/ix - $comment ($t string)')];
  30         $tests[-1]="TODO: { local \$TODO='[13:41] <BinGOs> cue *It is all Greek to me* joke.';\n$tests[-1] }"
  31             if $cp eq '0390' or $cp eq '03B0';
  32         $count++;
  33     }
  34 }
  35 eval join ";\n","plan tests=>".($count-1),@tests,"1"
  36     or die $@;
  37 __DATA__