This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Unicode::Normalize from version 1.19 to 1.21
[perl5.git] / cpan / Unicode-Normalize / t / func.t
1
2 BEGIN {
3     unless ('A' eq pack('U', 0x41)) {
4         print "1..0 # Unicode::Normalize cannot pack a Unicode code point\n";
5         exit 0;
6     }
7     unless (0x41 == unpack('U', 'A')) {
8         print "1..0 # Unicode::Normalize cannot get a Unicode code point\n";
9         exit 0;
10     }
11 }
12
13 BEGIN {
14     if ($ENV{PERL_CORE}) {
15         chdir('t') if -d 't';
16         @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
17     }
18 }
19
20 #########################
21
22 use strict;
23 use warnings;
24 BEGIN { $| = 1; print "1..217\n"; }
25 my $count = 0;
26 sub ok ($;$) {
27     my $p = my $r = shift;
28     if (@_) {
29         my $x = shift;
30         $p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x;
31     }
32     print $p ? "ok" : "not ok", ' ', ++$count, "\n";
33 }
34
35 use Unicode::Normalize qw(:all);
36
37 ok(1);
38
39 sub _pack_U { Unicode::Normalize::pack_U(@_) }
40 sub hexU { _pack_U map hex, split ' ', shift }
41
42 # This won't work on EBCDIC platforms prior to v5.8.0, which is when this
43 # translation function was defined
44 *to_native = (defined &utf8::unicode_to_native)
45              ? \&utf8::unicode_to_native
46              : sub { return shift };
47
48 #########################
49
50 ok(getCombinClass( to_native(0)),   0);
51 ok(getCombinClass(to_native(41)),   0);
52 ok(getCombinClass(to_native(65)),   0);
53 ok(getCombinClass( 768), 230);
54 ok(getCombinClass(1809),  36);
55
56 ok(getCanon(to_native(   0)), undef);
57 ok(getCanon(to_native(0x29)), undef);
58 ok(getCanon(to_native(0x41)), undef);
59 ok(getCanon(to_native(0x00C0)), _pack_U(0x0041, 0x0300));
60 ok(getCanon(to_native(0x00EF)), _pack_U(0x0069, 0x0308));
61 ok(getCanon(0x304C), _pack_U(0x304B, 0x3099));
62 ok(getCanon(0x1EA4), _pack_U(0x0041, 0x0302, 0x0301));
63 ok(getCanon(0x1F82), _pack_U(0x03B1, 0x0313, 0x0300, 0x0345));
64 ok(getCanon(0x1FAF), _pack_U(0x03A9, 0x0314, 0x0342, 0x0345));
65 ok(getCanon(0xAC00), _pack_U(0x1100, 0x1161));
66 ok(getCanon(0xAE00), _pack_U(0x1100, 0x1173, 0x11AF));
67 ok(getCanon(0x212C), undef);
68 ok(getCanon(0x3243), undef);
69 ok(getCanon(0xFA2D), _pack_U(0x9DB4));
70
71 # 20
72
73 ok(getCompat(to_native(   0)), undef);
74 ok(getCompat(to_native(0x29)), undef);
75 ok(getCompat(to_native(0x41)), undef);
76 ok(getCompat(to_native(0x00C0)), _pack_U(0x0041, 0x0300));
77 ok(getCompat(to_native(0x00EF)), _pack_U(0x0069, 0x0308));
78 ok(getCompat(0x304C), _pack_U(0x304B, 0x3099));
79 ok(getCompat(0x1EA4), _pack_U(0x0041, 0x0302, 0x0301));
80 ok(getCompat(0x1F82), _pack_U(0x03B1, 0x0313, 0x0300, 0x0345));
81 ok(getCompat(0x1FAF), _pack_U(0x03A9, 0x0314, 0x0342, 0x0345));
82 ok(getCompat(0x212C), _pack_U(0x0042));
83 ok(getCompat(0x3243), _pack_U(0x0028, 0x81F3, 0x0029));
84 ok(getCompat(0xAC00), _pack_U(0x1100, 0x1161));
85 ok(getCompat(0xAE00), _pack_U(0x1100, 0x1173, 0x11AF));
86 ok(getCompat(0xFA2D), _pack_U(0x9DB4));
87
88 # 34
89
90 ok(getComposite(to_native(   0), to_native(   0)), undef);
91 ok(getComposite(to_native(   0), to_native(0x29)), undef);
92 ok(getComposite(to_native(0x29), to_native(   0)), undef);
93 ok(getComposite(to_native(0x29), to_native(0x29)), undef);
94 ok(getComposite(to_native(   0), to_native(0x41)), undef);
95 ok(getComposite(to_native(0x41), to_native(   0)), undef);
96 ok(getComposite(to_native(0x41), to_native(0x41)), undef);
97 ok(getComposite(to_native(12), to_native(0x0300)), undef);
98 ok(getComposite(to_native(0x0055), 0xFF00), undef);
99 ok(getComposite(to_native(0x0041), 0x0300), to_native(0x00C0));
100 ok(getComposite(to_native(0x0055), 0x0300), to_native(0x00D9));
101 ok(getComposite(0x0112, 0x0300), 0x1E14);
102 ok(getComposite(0x1100, 0x1161), 0xAC00);
103 ok(getComposite(0x1100, 0x1173), 0xADF8);
104 ok(getComposite(0x1100, 0x11AF), undef);
105 ok(getComposite(0x1173, 0x11AF), undef);
106 ok(getComposite(0xAC00, 0x11A7), undef);
107 ok(getComposite(0xAC00, 0x11A8), 0xAC01);
108 ok(getComposite(0xADF8, 0x11AF), 0xAE00);
109
110 # 53
111
112 sub uprops {
113   my $uv = shift;
114   my $r = "";
115      $r .= isExclusion($uv)   ? 'X' : 'x';
116      $r .= isSingleton($uv)   ? 'S' : 's';
117      $r .= isNonStDecomp($uv) ? 'N' : 'n'; # Non-Starter Decomposition
118      $r .= isComp_Ex($uv)     ? 'F' : 'f'; # Full exclusion (X + S + N)
119      $r .= isComp2nd($uv)     ? 'B' : 'b'; # B = M = Y
120      $r .= isNFD_NO($uv)      ? 'D' : 'd';
121      $r .= isNFC_MAYBE($uv)   ? 'M' : 'm'; # Maybe
122      $r .= isNFC_NO($uv)      ? 'C' : 'c';
123      $r .= isNFKD_NO($uv)     ? 'K' : 'k';
124      $r .= isNFKC_MAYBE($uv)  ? 'Y' : 'y'; # maYbe
125      $r .= isNFKC_NO($uv)     ? 'G' : 'g';
126   return $r;
127 }
128
129 ok(uprops(to_native(0x0000)), 'xsnfbdmckyg'); # NULL
130 ok(uprops(to_native(0x0029)), 'xsnfbdmckyg'); # RIGHT PARENTHESIS
131 ok(uprops(to_native(0x0041)), 'xsnfbdmckyg'); # LATIN CAPITAL LETTER A
132 ok(uprops(to_native(0x00A0)), 'xsnfbdmcKyG'); # NO-BREAK SPACE
133 ok(uprops(to_native(0x00C0)), 'xsnfbDmcKyg'); # LATIN CAPITAL LETTER A WITH GRAVE
134 ok(uprops(0x0300), 'xsnfBdMckYg'); # COMBINING GRAVE ACCENT
135 ok(uprops(0x0344), 'xsNFbDmCKyG'); # COMBINING GREEK DIALYTIKA TONOS
136 ok(uprops(0x0387), 'xSnFbDmCKyG'); # GREEK ANO TELEIA
137 ok(uprops(0x0958), 'XsnFbDmCKyG'); # DEVANAGARI LETTER QA
138 ok(uprops(0x0F43), 'XsnFbDmCKyG'); # TIBETAN LETTER GHA
139 ok(uprops(0x1100), 'xsnfbdmckyg'); # HANGUL CHOSEONG KIYEOK
140 ok(uprops(0x1161), 'xsnfBdMckYg'); # HANGUL JUNGSEONG A
141 ok(uprops(0x11AF), 'xsnfBdMckYg'); # HANGUL JONGSEONG RIEUL
142 ok(uprops(0x212B), 'xSnFbDmCKyG'); # ANGSTROM SIGN
143 ok(uprops(0xAC00), 'xsnfbDmcKyg'); # HANGUL SYLLABLE GA
144 ok(uprops(0xF900), 'xSnFbDmCKyG'); # CJK COMPATIBILITY IDEOGRAPH-F900
145 ok(uprops(0xFB4E), 'XsnFbDmCKyG'); # HEBREW LETTER PE WITH RAFE
146 ok(uprops(0xFF71), 'xsnfbdmcKyG'); # HALFWIDTH KATAKANA LETTER A
147
148 # 71
149
150 ok(decompose(""), "");
151 ok(decompose("A"), "A");
152 ok(decompose("", 1), "");
153 ok(decompose("A", 1), "A");
154
155 ok(decompose(hexU("1E14 AC01")), hexU("0045 0304 0300 1100 1161 11A8"));
156 ok(decompose(hexU("AC00 AE00")), hexU("1100 1161 1100 1173 11AF"));
157 ok(decompose(hexU("304C FF76")), hexU("304B 3099 FF76"));
158
159 ok(decompose(hexU("1E14 AC01"), 1), hexU("0045 0304 0300 1100 1161 11A8"));
160 ok(decompose(hexU("AC00 AE00"), 1), hexU("1100 1161 1100 1173 11AF"));
161 ok(decompose(hexU("304C FF76"), 1), hexU("304B 3099 30AB"));
162
163 # don't modify the source
164 my $sDec = "\x{FA19}";
165 ok(decompose($sDec), "\x{795E}");
166 ok($sDec, "\x{FA19}");
167
168 # 83
169
170 ok(reorder(""), "");
171 ok(reorder("A"), "A");
172 ok(reorder(hexU("0041 0300 0315 0313 031b 0061")),
173            hexU("0041 031b 0300 0313 0315 0061"));
174 ok(reorder(hexU("00C1 0300 0315 0313 031b 0061 309A 3099")),
175            hexU("00C1 031b 0300 0313 0315 0061 309A 3099"));
176
177 # don't modify the source
178 my $sReord = "\x{3000}\x{300}\x{31b}";
179 ok(reorder($sReord), "\x{3000}\x{31b}\x{300}");
180 ok($sReord, "\x{3000}\x{300}\x{31b}");
181
182 # 89
183
184 ok(compose(""), "");
185 ok(compose("A"), "A");
186 ok(compose(hexU("0061 0300")),      hexU("00E0"));
187 ok(compose(hexU("0061 0300 031B")), hexU("00E0 031B"));
188 ok(compose(hexU("0061 0300 0315")), hexU("00E0 0315"));
189 ok(compose(hexU("0061 0300 0313")), hexU("00E0 0313"));
190 ok(compose(hexU("0061 031B 0300")), hexU("00E0 031B"));
191 ok(compose(hexU("0061 0315 0300")), hexU("0061 0315 0300"));
192 ok(compose(hexU("0061 0313 0300")), hexU("0061 0313 0300"));
193
194 # don't modify the source
195 my $sCom = "\x{304B}\x{3099}";
196 ok(compose($sCom), "\x{304C}");
197 ok($sCom, "\x{304B}\x{3099}");
198
199 # 100
200
201 ok(composeContiguous(""), "");
202 ok(composeContiguous("A"), "A");
203 ok(composeContiguous(hexU("0061 0300")),      hexU("00E0"));
204 ok(composeContiguous(hexU("0061 0300 031B")), hexU("00E0 031B"));
205 ok(composeContiguous(hexU("0061 0300 0315")), hexU("00E0 0315"));
206 ok(composeContiguous(hexU("0061 0300 0313")), hexU("00E0 0313"));
207 ok(composeContiguous(hexU("0061 031B 0300")), hexU("0061 031B 0300"));
208 ok(composeContiguous(hexU("0061 0315 0300")), hexU("0061 0315 0300"));
209 ok(composeContiguous(hexU("0061 0313 0300")), hexU("0061 0313 0300"));
210
211 # don't modify the source
212 my $sCtg = "\x{30DB}\x{309A}";
213 ok(composeContiguous($sCtg), "\x{30DD}");
214 ok($sCtg, "\x{30DB}\x{309A}");
215
216 # 111
217
218 sub answer { defined $_[0] ? $_[0] ? "YES" : "NO" : "MAYBE" }
219
220 ok(answer(checkNFD("")),  "YES");
221 ok(answer(checkNFC("")),  "YES");
222 ok(answer(checkNFKD("")), "YES");
223 ok(answer(checkNFKC("")), "YES");
224 ok(answer(check("NFD", "")), "YES");
225 ok(answer(check("NFC", "")), "YES");
226 ok(answer(check("NFKD","")), "YES");
227 ok(answer(check("NFKC","")), "YES");
228
229 # U+0000 to U+007F are prenormalized in all the normalization forms.
230 ok(answer(checkNFD("AZaz\t12!#`")),  "YES");
231 ok(answer(checkNFC("AZaz\t12!#`")),  "YES");
232 ok(answer(checkNFKD("AZaz\t12!#`")), "YES");
233 ok(answer(checkNFKC("AZaz\t12!#`")), "YES");
234 ok(answer(check("D", "AZaz\t12!#`")), "YES");
235 ok(answer(check("C", "AZaz\t12!#`")), "YES");
236 ok(answer(check("KD","AZaz\t12!#`")), "YES");
237 ok(answer(check("KC","AZaz\t12!#`")), "YES");
238
239 ok(answer(checkNFD(NFD(_pack_U(0xC1, 0x1100, 0x1173, 0x11AF)))), "YES");
240 ok(answer(checkNFD(hexU("20 C1 1100 1173 11AF"))), "NO");
241 ok(answer(checkNFC(hexU("20 C1 1173 11AF"))), "MAYBE");
242 ok(answer(checkNFC(hexU("20 C1 AE00 1100"))), "YES");
243 ok(answer(checkNFC(hexU("20 C1 AE00 1100 0300"))), "MAYBE");
244 ok(answer(checkNFC(hexU("212B 1100 0300"))), "NO");
245 ok(answer(checkNFC(hexU("1100 0300 212B"))), "NO");
246 ok(answer(checkNFC(hexU("0041 0327 030A"))), "MAYBE"); # A+cedilla+ring
247 ok(answer(checkNFC(hexU("0041 030A 0327"))), "NO");    # A+ring+cedilla
248 ok(answer(checkNFC(hexU("20 C1 FF71 2025"))),"YES");
249 ok(answer(check("NFC", hexU("20 C1 212B 300"))), "NO");
250 ok(answer(checkNFKD(hexU("20 C1 FF71 2025"))),   "NO");
251 ok(answer(checkNFKC(hexU("20 C1 AE00 2025"))), "NO");
252 ok(answer(checkNFKC(hexU("212B 1100 0300"))), "NO");
253 ok(answer(checkNFKC(hexU("1100 0300 212B"))), "NO");
254 ok(answer(checkNFKC(hexU("0041 0327 030A"))), "MAYBE"); # A+cedilla+ring
255 ok(answer(checkNFKC(hexU("0041 030A 0327"))), "NO");    # A+ring+cedilla
256 ok(answer(check("NFKC", hexU("20 C1 212B 300"))), "NO");
257
258 # 145
259
260 "012ABC" =~ /(\d+)(\w+)/;
261 ok("012" eq NFC $1 && "ABC" eq NFC $2);
262
263 ok(normalize('C', $1), "012");
264 ok(normalize('C', $2), "ABC");
265
266 ok(normalize('NFC', $1), "012");
267 ok(normalize('NFC', $2), "ABC");
268  # s/^NF// in normalize() must not prevent using $1, $&, etc.
269
270 # 150
271
272 # a string with initial zero should be treated like a number
273
274 # LATIN CAPITAL LETTER A WITH GRAVE
275 ok(getCombinClass(sprintf("0%d", to_native(192))), 0);
276 ok(getCanon (sprintf("0%d", to_native(192))), _pack_U(0x41, 0x300));
277 ok(getCompat(sprintf("0%d", to_native(192))), _pack_U(0x41, 0x300));
278 my $lead_zero = sprintf "0%d", to_native(65);
279 ok(getComposite($lead_zero, "0768"), to_native(192));
280 ok(isNFD_NO (sprintf("0%d", to_native(192))));
281 ok(isNFKD_NO(sprintf("0%d", to_native(192))));
282
283 # DEVANAGARI LETTER QA
284 ok(isExclusion("02392"));
285 ok(isComp_Ex  ("02392"));
286 ok(isNFC_NO   ("02392"));
287 ok(isNFKC_NO  ("02392"));
288 ok(isNFD_NO   ("02392"));
289 ok(isNFKD_NO  ("02392"));
290
291 # ANGSTROM SIGN
292 ok(isSingleton("08491"));
293 ok(isComp_Ex  ("08491"));
294 ok(isNFC_NO   ("08491"));
295 ok(isNFKC_NO  ("08491"));
296 ok(isNFD_NO   ("08491"));
297 ok(isNFKD_NO  ("08491"));
298
299 # COMBINING GREEK DIALYTIKA TONOS
300 ok(isNonStDecomp("0836"));
301 ok(isComp_Ex    ("0836"));
302 ok(isNFC_NO     ("0836"));
303 ok(isNFKC_NO    ("0836"));
304 ok(isNFD_NO     ("0836"));
305 ok(isNFKD_NO    ("0836"));
306
307 # COMBINING GRAVE ACCENT
308 ok(getCombinClass("0768"), 230);
309 ok(isComp2nd   ("0768"));
310 ok(isNFC_MAYBE ("0768"));
311 ok(isNFKC_MAYBE("0768"));
312
313 # HANGUL SYLLABLE GA
314 ok(getCombinClass("044032"), 0);
315 ok(getCanon("044032"),  _pack_U(0x1100, 0x1161));
316 ok(getCompat("044032"), _pack_U(0x1100, 0x1161));
317 ok(getComposite("04352", "04449"), 0xAC00);
318
319 # 182
320
321 # string with 22 combining characters: (0x300..0x315)
322 my $str_cc22 = _pack_U(0x3041, 0x300..0x315, 0x3042);
323 ok(decompose($str_cc22), $str_cc22);
324 ok(reorder($str_cc22), $str_cc22);
325 ok(compose($str_cc22), $str_cc22);
326 ok(composeContiguous($str_cc22), $str_cc22);
327 ok(NFD($str_cc22), $str_cc22);
328 ok(NFC($str_cc22), $str_cc22);
329 ok(NFKD($str_cc22), $str_cc22);
330 ok(NFKC($str_cc22), $str_cc22);
331 ok(FCD($str_cc22), $str_cc22);
332 ok(FCC($str_cc22), $str_cc22);
333
334 # 192
335
336 # string with 40 combining characters of the same class: (0x300..0x313)x2
337 my $str_cc40 = _pack_U(0x3041, 0x300..0x313, 0x300..0x313, 0x3042);
338 ok(decompose($str_cc40), $str_cc40);
339 ok(reorder($str_cc40), $str_cc40);
340 ok(compose($str_cc40), $str_cc40);
341 ok(composeContiguous($str_cc40), $str_cc40);
342 ok(NFD($str_cc40), $str_cc40);
343 ok(NFC($str_cc40), $str_cc40);
344 ok(NFKD($str_cc40), $str_cc40);
345 ok(NFKC($str_cc40), $str_cc40);
346 ok(FCD($str_cc40), $str_cc40);
347 ok(FCC($str_cc40), $str_cc40);
348
349 # 202
350
351 my $precomp = hexU("304C 304E 3050 3052 3054");
352 my $combseq = hexU("304B 3099 304D 3099 304F 3099 3051 3099 3053 3099");
353 ok(decompose($precomp x 5),  $combseq x 5);
354 ok(decompose($precomp x 10), $combseq x 10);
355 ok(decompose($precomp x 20), $combseq x 20);
356
357 my $hangsyl = hexU("AC00 B098 B2E4 B77C B9C8");
358 my $jamoseq = hexU("1100 1161 1102 1161 1103 1161 1105 1161 1106 1161");
359 ok(decompose($hangsyl x 5), $jamoseq x 5);
360 ok(decompose($hangsyl x 10), $jamoseq x 10);
361 ok(decompose($hangsyl x 20), $jamoseq x 20);
362
363 my $notcomp = hexU("304B 304D 304F 3051 3053");
364 ok(decompose($precomp . $notcomp),     $combseq . $notcomp);
365 ok(decompose($precomp . $notcomp x 5), $combseq . $notcomp x 5);
366 ok(decompose($precomp . $notcomp x10), $combseq . $notcomp x10);
367
368 # 211
369
370 my $preUnicode3_1 = !defined getCanon(0x1D15E);
371 my $preUnicode3_2 = !defined getCanon(0x2ADC);
372
373 # HEBREW LETTER YOD WITH HIRIQ
374 ok($preUnicode3_1 xor isExclusion(0xFB1D));
375 ok($preUnicode3_1 xor isComp_Ex  (0xFB1D));
376
377 # MUSICAL SYMBOL HALF NOTE
378 ok($preUnicode3_1 xor isExclusion(0x1D15E));
379 ok($preUnicode3_1 xor isComp_Ex  (0x1D15E));
380
381 # FORKING
382 ok($preUnicode3_2 xor isExclusion(0x2ADC));
383 ok($preUnicode3_2 xor isComp_Ex  (0x2ADC));
384
385 # 217
386