21 sub A::B::Intersection {
29 my $str = join "", map chr($_), 0x20 .. 0x6F;
31 # make sure it finds built-in class
32 is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
33 is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
35 # make sure it finds user-defined class
36 is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
38 # make sure it finds class in other package
39 is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
41 # make sure it finds class in other OTHER package
42 is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO');
44 # all of these should look in lib/unicore/bc/AL.pl
45 $str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}";
46 is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{070E}\x{070F}");
47 is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{070E}\x{070F}");
48 is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{070E}\x{070F}");
49 is(($str =~ /(\P{bc=AL}+)/)[0], "\x{070E}\x{070F}");
51 # make sure InGreek works
52 $str = "[\x{038B}\x{038C}\x{038D}]";
54 is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
55 is(($str =~ /(\p{Script:InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
56 is(($str =~ /(\p{Script=InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
57 is(($str =~ /(\p{sc:InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
58 is(($str =~ /(\p{sc=InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
62 my $updir = File::Spec->updir;
65 # the %utf8::... hashes are already in existence
66 # because utf8_pva.pl was run by utf8_heavy.pl
68 # non-General Category and non-Script
69 while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) {
70 my $prop_name = $utf8::PropertyAlias{$abbrev};
71 next unless $prop_name;
72 next if $abbrev eq "gc_sc";
74 for (sort keys %$files) {
75 my $filename = File::Spec->catfile(
76 $updir => lib => unicore => lib => $abbrev => "$files->{$_}.pl"
79 next unless -e $filename;
80 my ($h1, $h2) = map hex, split /\t/, (do $filename);
81 my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
83 for my $p ($prop_name, $abbrev) {
84 for my $c ($files->{$_}, $_) {
85 is($str =~ /(\p{$p: $c}+)/ && $1, substr($str, 0, -1));
86 is($str =~ /(\P{$p= $c}+)/ && $1, substr($str, -1));
92 # General Category and Script
93 for my $p ('gc', 'sc') {
94 while (my ($abbr) = each %{ $utf8::PropValueAlias{$p} }) {
95 my $filename = File::Spec->catfile(
96 $updir => lib => unicore => lib => gc_sc => "$utf8::PVA_abbr_map{gc_sc}{$abbr}.pl"
99 next unless -e $filename;
100 my ($h1, $h2) = map hex, split /\t/, (do $filename);
101 my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
103 for my $x ($p, { gc => 'General Category', sc => 'Script' }->{$p}) {
104 for my $y ($abbr, $utf8::PropValueAlias{$p}{$abbr}, $utf8::PVA_abbr_map{gc_sc}{$abbr}) {
105 is($str =~ /(\p{$x: $y}+)/ && $1, substr($str, 0, -1));
106 is($str =~ /(\P{$x= $y}+)/ && $1, substr($str, -1));
107 is($str =~ /(\p{$y}+)/ && $1, substr($str, 0, -1));
108 is($str =~ /(\P{$y}+)/ && $1, substr($str, -1));
114 # test extra properties (ASCII_Hex_Digit, Bidi_Control, etc.)
115 for (keys %utf8::PA_reverse) {
116 my $filename = File::Spec->catfile(
117 $updir => lib => unicore => lib => gc_sc => "$utf8::PA_reverse{$_}.pl"
120 next unless -e $filename;
121 my ($h1, $h2) = map hex, split /\t/, (do $filename);
122 my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
124 for my $x ('gc', 'General Category') {
125 for my $y ($_, $utf8::PA_reverse{$_}) {
126 is($str =~ /(\p{$x: $y}+)/ && $1, substr($str, 0, -1));
127 is($str =~ /(\P{$x= $y}+)/ && $1, substr($str, -1));
128 is($str =~ /(\p{$y}+)/ && $1, substr($str, 0, -1));
129 is($str =~ /(\P{$y}+)/ && $1, substr($str, -1));
134 # test the blocks (InFoobar)
135 for (grep $utf8::Canonical{$_} =~ /^In/, keys %utf8::Canonical) {
136 my $filename = File::Spec->catfile(
137 $updir => lib => unicore => lib => gc_sc => "$utf8::Canonical{$_}.pl"
140 next unless -e $filename;
141 my ($h1, $h2) = map hex, split /\t/, (do $filename);
142 my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
146 is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1));
147 is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1));
149 $blk =~ s/^In/Block:/;
151 is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1));
152 is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1));