Commit | Line | Data |
0f1b7392 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = qw(../lib .); |
4 | require "test.pl"; |
5 | } |
6 | |
a2bd7410 |
7 | plan tests => 4670; |
0f1b7392 |
8 | |
9 | sub MyUniClass { |
10 | <<END; |
11 | 0030 004F |
12 | END |
13 | } |
14 | |
15 | sub Other::Class { |
16 | <<END; |
17 | 0040 005F |
18 | END |
19 | } |
20 | |
21 | sub A::B::Intersection { |
22 | <<END; |
23 | +main::MyUniClass |
24 | &Other::Class |
25 | END |
26 | } |
27 | |
28 | |
29 | my $str = join "", map chr($_), 0x20 .. 0x6F; |
30 | |
31 | # make sure it finds built-in class |
32 | is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
12ac2576 |
33 | is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
0f1b7392 |
34 | |
35 | # make sure it finds user-defined class |
36 | is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO'); |
37 | |
38 | # make sure it finds class in other package |
39 | is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); |
40 | |
41 | # make sure it finds class in other OTHER package |
42 | is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO'); |
12ac2576 |
43 | |
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}"); |
50 | |
51 | # make sure InGreek works |
52 | $str = "[\x{038B}\x{038C}\x{038D}]"; |
53 | |
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}"); |
59 | |
12ac2576 |
60 | use File::Spec; |
61 | my $updir = File::Spec->updir; |
62 | |
12ac2576 |
63 | # the %utf8::... hashes are already in existence |
64 | # because utf8_pva.pl was run by utf8_heavy.pl |
65 | |
85827533 |
66 | *utf8::PropertyAlias = *utf8::PropertyAlias; # thwart a warning |
67 | |
68 | no warnings 'utf8'; # we do not want warnings about surrogates etc |
69 | |
12ac2576 |
70 | # non-General Category and non-Script |
71 | while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) { |
72 | my $prop_name = $utf8::PropertyAlias{$abbrev}; |
73 | next unless $prop_name; |
74 | next if $abbrev eq "gc_sc"; |
75 | |
76 | for (sort keys %$files) { |
77 | my $filename = File::Spec->catfile( |
78 | $updir => lib => unicore => lib => $abbrev => "$files->{$_}.pl" |
79 | ); |
80 | |
81 | next unless -e $filename; |
85827533 |
82 | my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1]; |
12ac2576 |
83 | my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1); |
84 | |
85 | for my $p ($prop_name, $abbrev) { |
86 | for my $c ($files->{$_}, $_) { |
87 | is($str =~ /(\p{$p: $c}+)/ && $1, substr($str, 0, -1)); |
88 | is($str =~ /(\P{$p= $c}+)/ && $1, substr($str, -1)); |
89 | } |
90 | } |
91 | } |
92 | } |
93 | |
94 | # General Category and Script |
95 | for my $p ('gc', 'sc') { |
96 | while (my ($abbr) = each %{ $utf8::PropValueAlias{$p} }) { |
97 | my $filename = File::Spec->catfile( |
98 | $updir => lib => unicore => lib => gc_sc => "$utf8::PVA_abbr_map{gc_sc}{$abbr}.pl" |
99 | ); |
100 | |
101 | next unless -e $filename; |
85827533 |
102 | my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1]; |
12ac2576 |
103 | my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1); |
104 | |
105 | for my $x ($p, { gc => 'General Category', sc => 'Script' }->{$p}) { |
106 | for my $y ($abbr, $utf8::PropValueAlias{$p}{$abbr}, $utf8::PVA_abbr_map{gc_sc}{$abbr}) { |
107 | is($str =~ /(\p{$x: $y}+)/ && $1, substr($str, 0, -1)); |
108 | is($str =~ /(\P{$x= $y}+)/ && $1, substr($str, -1)); |
109 | is($str =~ /(\p{$y}+)/ && $1, substr($str, 0, -1)); |
110 | is($str =~ /(\P{$y}+)/ && $1, substr($str, -1)); |
111 | } |
112 | } |
113 | } |
114 | } |
115 | |
116 | # test extra properties (ASCII_Hex_Digit, Bidi_Control, etc.) |
53cd5480 |
117 | SKIP: |
32d0b1dc |
118 | { |
26961258 |
119 | skip "Can't reliably derive class names from file names", 592 if $^O eq 'VMS'; |
53cd5480 |
120 | |
121 | # On case tolerant filesystems, Cf.pl will cause a -e test for cf.pl to |
122 | # return true. Try to work around this by reading the filenames explicitly |
123 | # to get a case sensitive test. N.B. This will fail if filename case is |
124 | # not preserved because you might go looking for a class name of CF or cf |
125 | # when you really want Cf. Storing case sensitive data in filenames is |
126 | # simply not portable. |
127 | |
32d0b1dc |
128 | my %files; |
12ac2576 |
129 | |
32d0b1dc |
130 | my $dirname = File::Spec->catdir($updir => lib => unicore => lib => gc_sc); |
131 | opendir D, $dirname or die $!; |
85827533 |
132 | @files{readdir(D)} = (); |
32d0b1dc |
133 | closedir D; |
134 | |
135 | for (keys %utf8::PA_reverse) { |
136 | my $leafname = "$utf8::PA_reverse{$_}.pl"; |
137 | next unless exists $files{$leafname}; |
12ac2576 |
138 | |
32d0b1dc |
139 | my $filename = File::Spec->catfile($dirname, $leafname); |
140 | |
85827533 |
141 | my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1]; |
32d0b1dc |
142 | my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1); |
143 | |
144 | for my $x ('gc', 'General Category') { |
145 | print "# $filename $x $_, $utf8::PA_reverse{$_}\n"; |
146 | for my $y ($_, $utf8::PA_reverse{$_}) { |
147 | is($str =~ /(\p{$x: $y}+)/ && $1, substr($str, 0, -1)); |
148 | is($str =~ /(\P{$x= $y}+)/ && $1, substr($str, -1)); |
149 | is($str =~ /(\p{$y}+)/ && $1, substr($str, 0, -1)); |
150 | is($str =~ /(\P{$y}+)/ && $1, substr($str, -1)); |
151 | } |
12ac2576 |
152 | } |
153 | } |
154 | } |
155 | |
156 | # test the blocks (InFoobar) |
157 | for (grep $utf8::Canonical{$_} =~ /^In/, keys %utf8::Canonical) { |
158 | my $filename = File::Spec->catfile( |
159 | $updir => lib => unicore => lib => gc_sc => "$utf8::Canonical{$_}.pl" |
160 | ); |
161 | |
162 | next unless -e $filename; |
85827533 |
163 | my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1]; |
12ac2576 |
164 | my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1); |
165 | |
166 | my $blk = $_; |
167 | |
168 | is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1)); |
169 | is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1)); |
170 | |
171 | $blk =~ s/^In/Block:/; |
172 | |
173 | is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1)); |
174 | is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1)); |
175 | } |