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