This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix various bugs in regex engine with mixed utf8/latin pattern and strings. Related...
[perl5.git] / t / op / reg_fold.t
CommitLineData
a0a388a1
YO
1use strict;
2use warnings;
3use Test::More;
4my $count=1;
5my @tests;
6use Cwd;
7
8my $file="../lib/unicore/CaseFolding.txt";
9open my $fh,"<",$file
10 or die "Failed to read '$file' from '".cwd()."': $!";
11while (<$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}
35eval join ";\n","plan tests=>".($count-1),@tests,"1"
36 or die $@;
37__DATA__