gmtime/localtime are busted around 2**48
[perl.git] / t / re / reg_fold.t
1 #!perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10 use warnings;
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,@folded)=split/[\s;]+/,$line||'';
20     next unless $type and ($type eq 'F' or $type eq 'C');
21     my $fold_above_latin1 = grep { hex("0x$_") > 255 } @folded;
22     $_="\\x{$_}" for @folded;
23     my $cpv=hex("0x$cp");
24     my $chr="\\x{$cp}";
25     my @str;
26     foreach my $swap (0, 1) {   # swap lhs and rhs, or not.
27         foreach my $charclass (0, 1) {   # Put rhs in [...], or not
28             my $lhs;
29             my $rhs;
30             if ($swap) {
31                 $lhs = join "", @folded;
32                 $rhs = $chr;
33                 $rhs = "[$rhs]" if $charclass;
34             } else {
35                 $lhs = $chr;
36                 $rhs = "";
37                 foreach my $rhs_char (@folded) {
38                     $rhs .= '[' if $charclass;
39                     $rhs .=  $rhs_char;
40                     $rhs .= ']' if $charclass;
41                 }
42             }
43             $lhs = "\"$lhs\"";
44             $rhs = "/^$rhs\$/i";
45
46             # Try both Latin1 and Unicode for code points below 256
47             foreach my $upgrade ("", 'utf8::upgrade($c); ') {
48                 if ($upgrade) {
49                     next if $swap && $fold_above_latin1;
50                     next if !$swap && $cpv > 255;
51                 }
52                 my $eval = "my \$c = $lhs; $upgrade\$c =~ $rhs";
53                 #print __LINE__, ": $eval\n";
54                 push @tests, qq[ok(eval '$eval', '$eval - $comment')];
55                 if (! $swap && ($cp eq '0390' || $cp eq '03B0')) {
56                     $tests[-1]="TODO: { local \$::TODO='[13:41] <BinGOs> cue *It is all Greek to me* joke.';\n$tests[-1] }"
57                 } elsif ($charclass && @folded > 1 && $swap && ! $upgrade && ! $fold_above_latin1) {
58                     $tests[-1]="TODO: { local \$::TODO='Multi-char, non-utf8 folded inside character class [ ] doesnt work';\n$tests[-1] }"
59                 } elsif (! $upgrade && $cpv >= 128 && $cpv <= 255 && $cpv != 0xb5) {
60                     $tests[-1]="TODO: { local \$::TODO='Most non-utf8 latin1 doesnt work';\n$tests[-1] }"
61                 } elsif (! $swap && $charclass && @folded > 1) {
62                     # There are a few of these that pass; most fail.
63                     $tests[-1]="TODO: { local \$::TODO='Some multi-char, f8 folded inside character class [ ] doesnt work';\n$tests[-1] }"
64                 }
65                 $count++;
66             }
67         }
68     }
69 }
70 eval join ";\n","plan tests=>".($count-1),@tests,"1"
71     or die $@;
72 __DATA__