3 # Tests that have to do with checking whether characters have (or not have)
4 # certain Unicode properties; belong (or not belong) to blocks, scripts, etc.
13 skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec (used by charnames)");
19 # This is the data to test.
21 # This is a hash; keys are the property to test.
22 # Values are arrays containing characters to test. The characters can
23 # have the following formats:
24 # '\N{CHARACTER NAME}' - Use character with that name
25 # '\x{1234}' - Use character with that hex escape
26 # '0x1234' - Use chr() to get that character
27 # "a" - Character to use
29 # If a character entry starts with ! the character does not belong to the class
31 # If the class is just single letter, we use both \pL and \p{L}
34 use charnames ':full';
44 'Lowercase Letter' => ["h", "!H"],
46 Common => ["!i", "3"],
47 Inherited => ["!j", '\x{300}'],
49 InBasicLatin => ['\N{LATIN CAPITAL LETTER A}'],
50 InLatin1Supplement => ['\N{LATIN CAPITAL LETTER A WITH GRAVE}'],
51 InLatinExtendedA => ['\N{LATIN CAPITAL LETTER A WITH MACRON}'],
52 InLatinExtendedB => ['\N{LATIN SMALL LETTER B WITH STROKE}'],
53 InKatakana => ['\N{KATAKANA LETTER SMALL A}'],
54 IsLatin => ["0x100", "0x212b"],
55 IsHebrew => ["0x5d0", "0xfb4f"],
56 IsGreek => ["0x37a", "0x386", "!0x387", "0x388",
57 "0x38a", "!0x38b", "0x38c"],
58 HangulSyllables => ['\x{AC00}'],
59 'Script=Latin' => ['\x{0100}'],
60 'Block=LatinExtendedA' => ['\x{0100}'],
61 'Category=UppercaseLetter' => ['\x{0100}'],
64 # It's ok to repeat class names.
67 $::IS_EBCDIC ? ['!\x{7f}', '\x{80}', '!\x{100}']
68 : ['!\x{7f}', '\x{80}', '\x{ff}', '!\x{100}'],
70 ['!\x{7f}', '!\x{80}', '!\x{ff}', '\x{100}'],
73 # Properties are case-insensitive, and may have whitespace,
74 # dashes and underscores.
76 'in-latin1_SUPPLEMENT' => ['\x{80}',
77 '\N{LATIN SMALL LETTER Y WITH DIAERESIS}'],
78 ' ^ In Latin 1 Supplement '
79 => ['!\x{80}', '\N{COFFIN}'],
80 'latin-1 supplement' => ['\x{80}', "0xDF"],
84 my @USER_DEFINED_PROPERTIES = (
86 # User defined properties
88 InKana1 => ['\x{3040}', '!\x{303F}'],
89 InKana2 => ['\x{3040}', '!\x{303F}'],
90 InKana3 => ['\x{3041}', '!\x{3040}'],
91 InNotKana => ['\x{3040}', '!\x{3041}'],
92 InConsonant => ['d', '!e'],
93 IsSyriac1 => ['\x{0712}', '!\x{072F}'],
94 IsSyriac1KanaMark => ['\x{309A}', '!\x{3090}'],
95 IsSyriac1KanaMark => ['\x{0730}', '!\x{0712}'],
96 '# User-defined character properties may lack \n at the end',
97 InGreekSmall => ['\N{GREEK SMALL LETTER PI}',
98 '\N{GREEK SMALL LETTER FINAL SIGMA}'],
99 InGreekCapital => ['\N{GREEK CAPITAL LETTER PI}', '!\x{03A2}'],
101 ASCII_Hex_Digit => ['!-', 'A'],
102 IsAsciiHexAndDash => ['-', 'A'],
105 my @USER_CASELESS_PROPERTIES = (
107 # User defined properties which differ depending on /i. Second entry is
108 # false regularly, true under /i
110 'IsMyUpper' => ["M", "!m" ],
115 # From the short properties we populate POSIX-like classes.
117 my %SHORT_PROPERTIES = (
118 'Ll' => ['m', '\N{CYRILLIC SMALL LETTER A}'],
119 'Lu' => ['M', '\N{GREEK CAPITAL LETTER ALPHA}'],
120 'Lo' => ['\N{HIRAGANA LETTER SMALL A}'],
121 # is also in other alphabetic
122 'Mn' => ['\N{HEBREW POINT RAFE}'],
123 'Nd' => ["0", '\N{ARABIC-INDIC DIGIT ZERO}'],
133 my @ILLEGAL_PROPERTIES =
134 qw[q qrst f foo isfoo infoo ISfoo INfoo Is::foo In::foo];
138 while (my ($class, $chars) = each %SHORT_PROPERTIES) {
139 push @{$d {IsAlpha}} => map {$class =~ /^[LM]/ ? $_ : "!$_"} @$chars;
140 push @{$d {IsAlnum}} => map {$class =~ /^[LMN]./ ? $_ : "!$_"} @$chars;
141 push @{$d {IsASCII}} => map {length ($_) == 1 || $_ eq '\x{00}'
142 ? $_ : "!$_"} @$chars;
143 push @{$d {IsCntrl}} => map {$class =~ /^C/ ? $_ : "!$_"} @$chars;
144 push @{$d {IsBlank}} => map {$class =~ /^Z[lps]/ ? $_ : "!$_"} @$chars;
145 push @{$d {IsDigit}} => map {$class =~ /^Nd$/ ? $_ : "!$_"} @$chars;
146 push @{$d {IsGraph}} => map {$class =~ /^([LMNPS]|Co)/
147 ? $_ : "!$_"} @$chars;
148 push @{$d {IsPrint}} => map {$class =~ /^([LMNPS]|Co|Zs)/
149 ? $_ : "!$_"} @$chars;
150 push @{$d {IsLower}} => map {$class =~ /^Ll$/ ? $_ : "!$_"} @$chars;
151 push @{$d {IsUpper}} => map {$class =~ /^L[ut]/ ? $_ : "!$_"} @$chars;
152 push @{$d {IsPunct}} => map {$class =~ /^P/ ? $_ : "!$_"} @$chars;
153 push @{$d {IsWord}} => map {$class =~ /^[LMN]/ || $_ eq "_"
154 ? $_ : "!$_"} @$chars;
155 push @{$d {IsSpace}} => map {$class =~ /^Z/ ||
156 length ($_) == 1 && ord ($_) >= 0x09
158 ? $_ : "!$_"} @$chars;
161 delete $d {IsASCII} if $::IS_EBCDIC;
163 push @CLASSES => "# Short properties" => %SHORT_PROPERTIES,
164 "# POSIX like properties" => %d,
165 "# User defined properties" => @USER_DEFINED_PROPERTIES;
169 # Calculate the number of tests.
172 for (my $i = 0; $i < @CLASSES; $i += 2) {
173 $i ++, redo if $CLASSES [$i] =~ /^\h*#\h*(.*)/;
174 $count += 2 * (length $CLASSES [$i] == 1 ? 4 : 2) * @{$CLASSES [$i + 1]};
176 $count += 4 * @ILLEGAL_PROPERTIES;
177 $count += 4 * grep {length $_ == 1} @ILLEGAL_PROPERTIES;
178 $count += 8 * @USER_CASELESS_PROPERTIES;
180 plan(tests => $count);
182 run_tests unless caller ();
185 my ($char, $match, $nomatch, $caseless) = @_;
186 $caseless = "" unless defined $caseless;
187 $caseless = 'i' if $caseless;
191 if ($char =~ /^\\/) {
192 $str = eval qq ["$char"];
193 $name = qq ["$char"];
195 elsif ($char =~ /^0x([0-9A-Fa-f]+)$/) {
197 $name = "chr ($char)";
201 $name = qq ["$char"];
205 my $pat = "qr/$match/$caseless";
206 my $match_pat = eval $pat;
207 is($@, '', "$pat compiled correctly to a regexp: $@");
208 like($str, $match_pat, "$name correctly matched");
211 $pat = "qr/$nomatch/$caseless";
212 my $nomatch_pat = eval $pat;
213 is($@, '', "$pat compiled correctly to a regexp: $@");
214 unlike($str, $nomatch_pat, "$name correctly did not match");
220 my $class = shift @CLASSES;
221 if ($class =~ /^\h*#\h*(.*)/) {
225 last unless @CLASSES;
226 my $chars = shift @CLASSES;
227 my @in = grep {!/^!./} @$chars;
228 my @out = map {s/^!(?=.)//; $_} grep { /^!./} @$chars;
229 my $in_pat = eval qq ['\\p{$class}'];
230 my $out_pat = eval qq ['\\P{$class}'];
232 match $_, $in_pat, $out_pat for @in;
233 match $_, $out_pat, $in_pat for @out;
235 if (1 == length $class) { # Repeat without braces if name length 1
236 my $in_pat = eval qq ['\\p$class'];
237 my $out_pat = eval qq ['\\P$class'];
239 match $_, $in_pat, $out_pat for @in;
240 match $_, $out_pat, $in_pat for @out;
245 my $pat = qr /^Can't find Unicode property definition/;
246 print "# Illegal properties\n";
247 foreach my $p (@ILLEGAL_PROPERTIES) {
249 my $r = eval "'a' =~ /\\p{$p}/; 1";
250 is($r, undef, "Unknown Unicode property \\p{$p}");
251 like($@, $pat, "Unknown Unicode property \\p{$p}");
253 my $s = eval "'a' =~ /\\P{$p}/; 1";
254 is($s, undef, "Unknown Unicode property \\p{$p}");
255 like($@, $pat, "Unknown Unicode property \\p{$p}");
256 if (length $p == 1) {
258 my $r = eval "'a' =~ /\\p$p/; 1";
259 is($r, undef, "Unknown Unicode property \\p$p");
260 like($@, $pat, "Unknown Unicode property \\p$p");
262 my $s = eval "'a' =~ /\\P$p/; 1";
263 is($r, undef, "Unknown Unicode property \\P$p");
264 like($@, $pat, "Unknown Unicode property \\P$p");
268 print "# User-defined properties with /i differences\n";
269 foreach my $class (shift @USER_CASELESS_PROPERTIES) {
270 my $chars_ref = shift @USER_CASELESS_PROPERTIES;
271 my @in = grep {!/^!./} @$chars_ref;
272 my @out = map {s/^!(?=.)//; $_} grep { /^!./} @$chars_ref;
273 my $in_pat = eval qq ['\\p{$class}'];
274 my $out_pat = eval qq ['\\P{$class}'];
276 # Verify works as regularly for not /i
277 match $_, $in_pat, $out_pat for @in;
278 match $_, $out_pat, $in_pat for @out;
280 # Verify that adding /i doesn't change the in set.
281 match $_, $in_pat, $out_pat, 'i' for @in;
283 # Verify that adding /i does change the out set to match.
284 match $_, $in_pat, $out_pat, 'i' for @out;
290 # User defined properties
309 sub InNotKana {<<'--'}
315 sub InConsonant {<<'--'} # Not EBCDIC-aware.
324 sub IsSyriac1 {<<'--'}
329 sub InGreekSmall {return "03B1\t03C9"}
330 sub InGreekCapital {return "0391\t03A9\n-03A2"}
332 sub IsAsciiHexAndDash {<<'--'}
333 +utf8::ASCII_Hex_Digit
338 my $caseless = shift;
340 return "0041\t005A\n0061\t007A"
347 # Verify that can use user-defined properties inside another one
348 sub IsSyriac1KanaMark {<<'--'}
354 # fake user-defined properties; these subs shouldn't be called, because
355 # their names don't start with In or Is