This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH [perl #58430] Unicode::UCD::casefold() does not work as documented,
[perl5.git] / lib / Unicode / UCD.t
1 #!perl -w
2 BEGIN {
3     if (ord("A") != 65) {
4         print "1..0 # Skip: EBCDIC\n";
5         exit 0;
6     }
7     chdir 't' if -d 't';
8     @INC = '../lib';
9     @INC = "::lib" if $^O eq 'MacOS'; # module parses @INC itself
10     require Config; import Config;
11     if ($Config{'extensions'} !~ /\bStorable\b/) {
12         print "1..0 # Skip: Storable was not built; Unicode::UCD uses Storable\n";
13         exit 0;
14     }
15 }
16
17 use strict;
18 use Unicode::UCD;
19 use Test::More;
20
21 BEGIN { plan tests => 239 };
22
23 use Unicode::UCD 'charinfo';
24
25 my $charinfo;
26
27 $charinfo = charinfo(0x41);
28
29 is($charinfo->{code},           '0041', 'LATIN CAPITAL LETTER A');
30 is($charinfo->{name},           'LATIN CAPITAL LETTER A');
31 is($charinfo->{category},       'Lu');
32 is($charinfo->{combining},      '0');
33 is($charinfo->{bidi},           'L');
34 is($charinfo->{decomposition},  '');
35 is($charinfo->{decimal},        '');
36 is($charinfo->{digit},          '');
37 is($charinfo->{numeric},        '');
38 is($charinfo->{mirrored},       'N');
39 is($charinfo->{unicode10},      '');
40 is($charinfo->{comment},        '');
41 is($charinfo->{upper},          '');
42 is($charinfo->{lower},          '0061');
43 is($charinfo->{title},          '');
44 is($charinfo->{block},          'Basic Latin');
45 is($charinfo->{script},         'Latin');
46
47 $charinfo = charinfo(0x100);
48
49 is($charinfo->{code},           '0100', 'LATIN CAPITAL LETTER A WITH MACRON');
50 is($charinfo->{name},           'LATIN CAPITAL LETTER A WITH MACRON');
51 is($charinfo->{category},       'Lu');
52 is($charinfo->{combining},      '0');
53 is($charinfo->{bidi},           'L');
54 is($charinfo->{decomposition},  '0041 0304');
55 is($charinfo->{decimal},        '');
56 is($charinfo->{digit},          '');
57 is($charinfo->{numeric},        '');
58 is($charinfo->{mirrored},       'N');
59 is($charinfo->{unicode10},      'LATIN CAPITAL LETTER A MACRON');
60 is($charinfo->{comment},        '');
61 is($charinfo->{upper},          '');
62 is($charinfo->{lower},          '0101');
63 is($charinfo->{title},          '');
64 is($charinfo->{block},          'Latin Extended-A');
65 is($charinfo->{script},         'Latin');
66
67 # 0x0590 is in the Hebrew block but unused.
68
69 $charinfo = charinfo(0x590);
70
71 is($charinfo->{code},          undef,   '0x0590 - unused Hebrew');
72 is($charinfo->{name},          undef);
73 is($charinfo->{category},      undef);
74 is($charinfo->{combining},     undef);
75 is($charinfo->{bidi},          undef);
76 is($charinfo->{decomposition}, undef);
77 is($charinfo->{decimal},       undef);
78 is($charinfo->{digit},         undef);
79 is($charinfo->{numeric},       undef);
80 is($charinfo->{mirrored},      undef);
81 is($charinfo->{unicode10},     undef);
82 is($charinfo->{comment},       undef);
83 is($charinfo->{upper},         undef);
84 is($charinfo->{lower},         undef);
85 is($charinfo->{title},         undef);
86 is($charinfo->{block},         undef);
87 is($charinfo->{script},        undef);
88
89 # 0x05d0 is in the Hebrew block and used.
90
91 $charinfo = charinfo(0x5d0);
92
93 is($charinfo->{code},           '05D0', '05D0 - used Hebrew');
94 is($charinfo->{name},           'HEBREW LETTER ALEF');
95 is($charinfo->{category},       'Lo');
96 is($charinfo->{combining},      '0');
97 is($charinfo->{bidi},           'R');
98 is($charinfo->{decomposition},  '');
99 is($charinfo->{decimal},        '');
100 is($charinfo->{digit},          '');
101 is($charinfo->{numeric},        '');
102 is($charinfo->{mirrored},       'N');
103 is($charinfo->{unicode10},      '');
104 is($charinfo->{comment},        '');
105 is($charinfo->{upper},          '');
106 is($charinfo->{lower},          '');
107 is($charinfo->{title},          '');
108 is($charinfo->{block},          'Hebrew');
109 is($charinfo->{script},         'Hebrew');
110
111 # An open syllable in Hangul.
112
113 $charinfo = charinfo(0xAC00);
114
115 is($charinfo->{code},           'AC00', 'HANGUL SYLLABLE-AC00');
116 is($charinfo->{name},           'HANGUL SYLLABLE-AC00');
117 is($charinfo->{category},       'Lo');
118 is($charinfo->{combining},      '0');
119 is($charinfo->{bidi},           'L');
120 is($charinfo->{decomposition},  undef);
121 is($charinfo->{decimal},        '');
122 is($charinfo->{digit},          '');
123 is($charinfo->{numeric},        '');
124 is($charinfo->{mirrored},       'N');
125 is($charinfo->{unicode10},      '');
126 is($charinfo->{comment},        '');
127 is($charinfo->{upper},          '');
128 is($charinfo->{lower},          '');
129 is($charinfo->{title},          '');
130 is($charinfo->{block},          'Hangul Syllables');
131 is($charinfo->{script},         'Hangul');
132
133 # A closed syllable in Hangul.
134
135 $charinfo = charinfo(0xAE00);
136
137 is($charinfo->{code},           'AE00', 'HANGUL SYLLABLE-AE00');
138 is($charinfo->{name},           'HANGUL SYLLABLE-AE00');
139 is($charinfo->{category},       'Lo');
140 is($charinfo->{combining},      '0');
141 is($charinfo->{bidi},           'L');
142 is($charinfo->{decomposition},  undef);
143 is($charinfo->{decimal},        '');
144 is($charinfo->{digit},          '');
145 is($charinfo->{numeric},        '');
146 is($charinfo->{mirrored},       'N');
147 is($charinfo->{unicode10},      '');
148 is($charinfo->{comment},        '');
149 is($charinfo->{upper},          '');
150 is($charinfo->{lower},          '');
151 is($charinfo->{title},          '');
152 is($charinfo->{block},          'Hangul Syllables');
153 is($charinfo->{script},         'Hangul');
154
155 $charinfo = charinfo(0x1D400);
156
157 is($charinfo->{code},           '1D400', 'MATHEMATICAL BOLD CAPITAL A');
158 is($charinfo->{name},           'MATHEMATICAL BOLD CAPITAL A');
159 is($charinfo->{category},       'Lu');
160 is($charinfo->{combining},      '0');
161 is($charinfo->{bidi},           'L');
162 is($charinfo->{decomposition},  '<font> 0041');
163 is($charinfo->{decimal},        '');
164 is($charinfo->{digit},          '');
165 is($charinfo->{numeric},        '');
166 is($charinfo->{mirrored},       'N');
167 is($charinfo->{unicode10},      '');
168 is($charinfo->{comment},        '');
169 is($charinfo->{upper},          '');
170 is($charinfo->{lower},          '');
171 is($charinfo->{title},          '');
172 is($charinfo->{block},          'Mathematical Alphanumeric Symbols');
173 is($charinfo->{script},         'Common');
174
175 $charinfo = charinfo(0x9FBA);   #Bug 58428
176
177 is($charinfo->{code},           '9FBA', 'U+9FBA');
178 is($charinfo->{name},           'CJK UNIFIED IDEOGRAPH-9FBA');
179 is($charinfo->{category},       'Lo');
180 is($charinfo->{combining},      '0');
181 is($charinfo->{bidi},           'L');
182 is($charinfo->{decomposition},  '');
183 is($charinfo->{decimal},        '');
184 is($charinfo->{digit},          '');
185 is($charinfo->{numeric},        '');
186 is($charinfo->{mirrored},       'N');
187 is($charinfo->{unicode10},      '');
188 is($charinfo->{comment},        '');
189 is($charinfo->{upper},          '');
190 is($charinfo->{lower},          '');
191 is($charinfo->{title},          '');
192 is($charinfo->{block},          'CJK Unified Ideographs');
193 is($charinfo->{script},         'Han');
194
195 use Unicode::UCD qw(charblock charscript);
196
197 # 0x0590 is in the Hebrew block but unused.
198
199 is(charblock(0x590),          'Hebrew', '0x0590 - Hebrew unused charblock');
200 is(charscript(0x590),         undef,    '0x0590 - Hebrew unused charscript');
201
202 $charinfo = charinfo(0xbe);
203
204 is($charinfo->{code},           '00BE', 'VULGAR FRACTION THREE QUARTERS');
205 is($charinfo->{name},           'VULGAR FRACTION THREE QUARTERS');
206 is($charinfo->{category},       'No');
207 is($charinfo->{combining},      '0');
208 is($charinfo->{bidi},           'ON');
209 is($charinfo->{decomposition},  '<fraction> 0033 2044 0034');
210 is($charinfo->{decimal},        '');
211 is($charinfo->{digit},          '');
212 is($charinfo->{numeric},        '3/4');
213 is($charinfo->{mirrored},       'N');
214 is($charinfo->{unicode10},      'FRACTION THREE QUARTERS');
215 is($charinfo->{comment},        '');
216 is($charinfo->{upper},          '');
217 is($charinfo->{lower},          '');
218 is($charinfo->{title},          '');
219 is($charinfo->{block},          'Latin-1 Supplement');
220 is($charinfo->{script},         'Common');
221
222 use Unicode::UCD qw(charblocks charscripts);
223
224 my $charblocks = charblocks();
225
226 ok(exists $charblocks->{Thai}, 'Thai charblock exists');
227 is($charblocks->{Thai}->[0]->[0], hex('0e00'));
228 ok(!exists $charblocks->{PigLatin}, 'PigLatin charblock does not exist');
229
230 my $charscripts = charscripts();
231
232 ok(exists $charscripts->{Armenian}, 'Armenian charscript exists');
233 is($charscripts->{Armenian}->[0]->[0], hex('0531'));
234 ok(!exists $charscripts->{PigLatin}, 'PigLatin charscript does not exist');
235
236 my $charscript;
237
238 $charscript = charscript("12ab");
239 is($charscript, 'Ethiopic', 'Ethiopic charscript');
240
241 $charscript = charscript("0x12ab");
242 is($charscript, 'Ethiopic');
243
244 $charscript = charscript("U+12ab");
245 is($charscript, 'Ethiopic');
246
247 my $ranges;
248
249 $ranges = charscript('Ogham');
250 is($ranges->[1]->[0], hex('1681'), 'Ogham charscript');
251 is($ranges->[1]->[1], hex('169a'));
252
253 use Unicode::UCD qw(charinrange);
254
255 $ranges = charscript('Cherokee');
256 ok(!charinrange($ranges, "139f"), 'Cherokee charscript');
257 ok( charinrange($ranges, "13a0"));
258 ok( charinrange($ranges, "13f4"));
259 ok(!charinrange($ranges, "13f5"));
260
261 use Unicode::UCD qw(general_categories);
262
263 my $gc = general_categories();
264
265 ok(exists $gc->{L}, 'has L');
266 is($gc->{L}, 'Letter', 'L is Letter');
267 is($gc->{Lu}, 'UppercaseLetter', 'Lu is UppercaseLetter');
268
269 use Unicode::UCD qw(bidi_types);
270
271 my $bt = bidi_types();
272
273 ok(exists $bt->{L}, 'has L');
274 is($bt->{L}, 'Left-to-Right', 'L is Left-to-Right');
275 is($bt->{AL}, 'Right-to-Left Arabic', 'AL is Right-to-Left Arabic');
276
277 # If this fails, then maybe one should look at the Unicode changes to see
278 # what else might need to be updated.
279 is(Unicode::UCD::UnicodeVersion, '5.1.0', 'UnicodeVersion');
280
281 use Unicode::UCD qw(compexcl);
282
283 ok(!compexcl(0x0100), 'compexcl');
284 ok( compexcl(0x0958));
285
286 use Unicode::UCD qw(casefold);
287
288 my $casefold;
289
290 $casefold = casefold(0x41);
291
292 is($casefold->{code}, '0041', 'casefold 0x41 code');
293 is($casefold->{status}, 'C', 'casefold 0x41 status');
294 is($casefold->{mapping}, '0061', 'casefold 0x41 mapping');
295 is($casefold->{full}, '0061', 'casefold 0x41 full');
296 is($casefold->{simple}, '0061', 'casefold 0x41 simple');
297 is($casefold->{turkic}, "", 'casefold 0x41 turkic');
298
299 $casefold = casefold(0xdf);
300
301 is($casefold->{code}, '00DF', 'casefold 0xDF code');
302 is($casefold->{status}, 'F', 'casefold 0xDF status');
303 is($casefold->{mapping}, '0073 0073', 'casefold 0xDF mapping');
304 is($casefold->{full}, '0073 0073', 'casefold 0xDF full');
305 is($casefold->{simple}, "", 'casefold 0xDF simple');
306 is($casefold->{turkic}, "", 'casefold 0xDF turkic');
307
308 # Do different tests depending on if version <= 3.1, or not.
309 (my $version = Unicode::UCD::UnicodeVersion) =~ /^(\d+)\.(\d+)/;
310 if (defined $1 && ($1 <= 2 || $1 == 3 && defined $2 && $2 <= 1)) {
311         $casefold = casefold(0x130);
312
313         is($casefold->{code}, '0130', 'casefold 0x130 code');
314         is($casefold->{status}, 'I' , 'casefold 0x130 status');
315         is($casefold->{mapping}, '0069', 'casefold 0x130 mapping');
316         is($casefold->{full}, '0069', 'casefold 0x130 full');
317         is($casefold->{simple}, "0069", 'casefold 0x130 simple');
318         is($casefold->{turkic}, "0069", 'casefold 0x130 turkic');
319
320         $casefold = casefold(0x131);
321
322         is($casefold->{code}, '0131', 'casefold 0x131 code');
323         is($casefold->{status}, 'I' , 'casefold 0x131 status');
324         is($casefold->{mapping}, '0069', 'casefold 0x131 mapping');
325         is($casefold->{full}, '0069', 'casefold 0x131 full');
326         is($casefold->{simple}, "0069", 'casefold 0x131 simple');
327         is($casefold->{turkic}, "0069", 'casefold 0x131 turkic');
328 } else {
329         $casefold = casefold(0x49);
330
331         is($casefold->{code}, '0049', 'casefold 0x49 code');
332         is($casefold->{status}, 'C' , 'casefold 0x49 status');
333         is($casefold->{mapping}, '0069', 'casefold 0x49 mapping');
334         is($casefold->{full}, '0069', 'casefold 0x49 full');
335         is($casefold->{simple}, "0069", 'casefold 0x49 simple');
336         is($casefold->{turkic}, "0131", 'casefold 0x49 turkic');
337
338         $casefold = casefold(0x130);
339
340         is($casefold->{code}, '0130', 'casefold 0x130 code');
341         is($casefold->{status}, 'F' , 'casefold 0x130 status');
342         is($casefold->{mapping}, '0069 0307', 'casefold 0x130 mapping');
343         is($casefold->{full}, '0069 0307', 'casefold 0x130 full');
344         is($casefold->{simple}, "", 'casefold 0x130 simple');
345         is($casefold->{turkic}, "0069", 'casefold 0x130 turkic');
346 }
347
348 $casefold = casefold(0x1F88);
349
350 is($casefold->{code}, '1F88', 'casefold 0x1F88 code');
351 is($casefold->{status}, 'S' , 'casefold 0x1F88 status');
352 is($casefold->{mapping}, '1F80', 'casefold 0x1F88 mapping');
353 is($casefold->{full}, '1F00 03B9', 'casefold 0x1F88 full');
354 is($casefold->{simple}, '1F80', 'casefold 0x1F88 simple');
355 is($casefold->{turkic}, "", 'casefold 0x1F88 turkic');
356
357 ok(!casefold(0x20));
358
359 use Unicode::UCD qw(casespec);
360
361 my $casespec;
362
363 ok(!casespec(0x41));
364
365 $casespec = casespec(0xdf);
366
367 ok($casespec->{code} eq '00DF' &&
368    $casespec->{lower} eq '00DF'  &&
369    $casespec->{title} eq '0053 0073'  &&
370    $casespec->{upper} eq '0053 0053' &&
371    !defined $casespec->{condition}, 'casespec 0xDF');
372
373 $casespec = casespec(0x307);
374
375 ok($casespec->{az}->{code} eq '0307' &&
376    !defined $casespec->{az}->{lower} &&
377    $casespec->{az}->{title} eq '0307'  &&
378    $casespec->{az}->{upper} eq '0307' &&
379    $casespec->{az}->{condition} eq 'az After_I',
380    'casespec 0x307');
381
382 # perl #7305 UnicodeCD::compexcl is weird
383
384 for (1) {my $a=compexcl $_}
385 ok(1, 'compexcl read-only $_: perl #7305');
386 map {compexcl $_} %{{1=>2}};
387 ok(1, 'compexcl read-only hash: perl #7305');
388
389 is(Unicode::UCD::_getcode('123'),     123, "_getcode(123)");
390 is(Unicode::UCD::_getcode('0123'),  0x123, "_getcode(0123)");
391 is(Unicode::UCD::_getcode('0x123'), 0x123, "_getcode(0x123)");
392 is(Unicode::UCD::_getcode('0X123'), 0x123, "_getcode(0X123)");
393 is(Unicode::UCD::_getcode('U+123'), 0x123, "_getcode(U+123)");
394 is(Unicode::UCD::_getcode('u+123'), 0x123, "_getcode(u+123)");
395 is(Unicode::UCD::_getcode('U+1234'),   0x1234, "_getcode(U+1234)");
396 is(Unicode::UCD::_getcode('U+12345'), 0x12345, "_getcode(U+12345)");
397 is(Unicode::UCD::_getcode('123x'),    undef, "_getcode(123x)");
398 is(Unicode::UCD::_getcode('x123'),    undef, "_getcode(x123)");
399 is(Unicode::UCD::_getcode('0x123x'),  undef, "_getcode(x123)");
400 is(Unicode::UCD::_getcode('U+123x'),  undef, "_getcode(x123)");
401
402 {
403     my $r1 = charscript('Latin');
404     my $n1 = @$r1;
405     is($n1, 42, "number of ranges in Latin script (Unicode 5.1.0)");
406     shift @$r1 while @$r1;
407     my $r2 = charscript('Latin');
408     is(@$r2, $n1, "modifying results should not mess up internal caches");
409 }
410
411 {
412         is(charinfo(0xdeadbeef), undef, "[perl #23273] warnings in Unicode::UCD");
413 }
414
415 use Unicode::UCD qw(namedseq);
416
417 is(namedseq("KATAKANA LETTER AINU P"), "\x{31F7}\x{309A}", "namedseq");
418 is(namedseq("KATAKANA LETTER AINU Q"), undef);
419 is(namedseq(), undef);
420 is(namedseq(qw(foo bar)), undef);
421 my @ns = namedseq("KATAKANA LETTER AINU P");
422 is(scalar @ns, 2);
423 is($ns[0], 0x31F7);
424 is($ns[1], 0x309A);
425 my %ns = namedseq();
426 is($ns{"KATAKANA LETTER AINU P"}, "\x{31F7}\x{309A}");
427 @ns = namedseq(42);
428 is(@ns, 0);
429