t/op/reg_fold.t

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