This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
b3433a9e5f5417dc084b2e4612d192a170aa5534
[perl5.git] / cpan / Unicode-Collate / t / index.t
1
2 BEGIN {
3     unless ("A" eq pack('U', 0x41)) {
4         print "1..0 # Unicode::Collate " .
5             "cannot stringify a Unicode code point\n";
6         exit 0;
7     }
8     if ($ENV{PERL_CORE}) {
9         chdir('t') if -d 't';
10         @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
11     }
12 }
13
14 use strict;
15 use warnings;
16 BEGIN { $| = 1; print "1..71\n"; }
17 my $count = 0;
18 sub ok ($;$) {
19     my $p = my $r = shift;
20     if (@_) {
21         my $x = shift;
22         $p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x;
23     }
24     print $p ? "ok" : "not ok", ' ', ++$count, "\n";
25 }
26
27 use Unicode::Collate;
28
29 ok(1);
30
31 #########################
32
33 our $IsEBCDIC = ord("A") != 0x41;
34
35 my $Collator = Unicode::Collate->new(
36   table => 'keys.txt',
37   normalization => undef,
38 );
39
40 ##############
41
42 my %old_level = $Collator->change(level => 2);
43
44 my $str;
45
46 my $orig = "This is a Perl book.";
47 my $sub = "PERL";
48 my $rep = "camel";
49 my $ret = "This is a camel book.";
50
51 $str = $orig;
52 if (my($pos,$len) = $Collator->index($str, $sub)) {
53   substr($str, $pos, $len, $rep);
54 }
55
56 ok($str, $ret);
57
58 $Collator->change(%old_level);
59
60 $str = $orig;
61 if (my($pos,$len) = $Collator->index($str, $sub)) {
62   substr($str, $pos, $len, $rep);
63 }
64
65 ok($str, $orig);
66
67 ##############
68
69 my $match;
70
71 $Collator->change(level => 1);
72
73 $str = "Pe\x{300}rl";
74 $sub = "pe";
75 $ret = "Pe\x{300}";
76 $match = undef;
77 if (my($pos, $len) = $Collator->index($str, $sub)) {
78     $match = substr($str, $pos, $len);
79 }
80 ok($match, $ret);
81
82 $str = "P\x{300}e\x{300}\x{301}\x{303}rl";
83 $sub = "pE";
84 $ret = "P\x{300}e\x{300}\x{301}\x{303}";
85 $match = undef;
86 if (my($pos, $len) = $Collator->index($str, $sub)) {
87     $match = substr($str, $pos, $len);
88 }
89 ok($match, $ret);
90
91 $Collator->change(level => 2);
92
93 $str = "Pe\x{300}rl";
94 $sub = "pe";
95 $ret = undef;
96 $match = undef;
97 if (my($pos, $len) = $Collator->index($str, $sub)) {
98     $match = substr($str, $pos, $len);
99 }
100 ok($match, $ret);
101
102 $str = "P\x{300}e\x{300}\x{301}\x{303}rl";
103 $sub = "pE";
104 $ret = undef;
105 $match = undef;
106 if (my($pos, $len) = $Collator->index($str, $sub)) {
107     $match = substr($str, $pos, $len);
108 }
109 ok($match, $ret);
110
111 $str = "Pe\x{300}rl";
112 $sub = "pe\x{300}";
113 $ret = "Pe\x{300}";
114 $match = undef;
115 if (my($pos, $len) = $Collator->index($str, $sub)) {
116     $match = substr($str, $pos, $len);
117 }
118 ok($match, $ret);
119
120 $str = "P\x{300}e\x{300}\x{301}\x{303}rl";
121 $sub = "p\x{300}E\x{300}\x{301}\x{303}";
122 $ret = "P\x{300}e\x{300}\x{301}\x{303}";
123 $match = undef;
124 if (my($pos, $len) = $Collator->index($str, $sub)) {
125     $match = substr($str, $pos, $len);
126 }
127 ok($match, $ret);
128
129 ##############
130
131 $Collator->change(level => 1);
132
133 $str = $IsEBCDIC
134     ? "Ich mu\x{0059} studieren Perl."
135     : "Ich mu\x{00DF} studieren Perl.";
136 $sub = $IsEBCDIC
137     ? "m\x{00DC}ss"
138     : "m\x{00FC}ss";
139 $ret = $IsEBCDIC
140     ? "mu\x{0059}"
141     : "mu\x{00DF}";
142 $match = undef;
143 if (my($pos, $len) = $Collator->index($str, $sub)) {
144     $match = substr($str, $pos, $len);
145 }
146 ok($match, $ret);
147
148 $Collator->change(%old_level);
149
150 $match = undef;
151 if (my($pos, $len) = $Collator->index($str, $sub)) {
152     $match = substr($str, $pos, $len);
153 }
154 ok($match, undef);
155
156 $match = undef;
157 if (my($pos,$len) = $Collator->index("", "")) {
158     $match = substr("", $pos, $len);
159 }
160 ok($match, "");
161
162 $match = undef;
163 if (my($pos,$len) = $Collator->index("", "abc")) {
164     $match = substr("", $pos, $len);
165 }
166 ok($match, undef);
167
168 ##############
169
170 $Collator->change(level => 1);
171
172 $str = "\0\cA\0\cAe\0\x{300}\cA\x{301}\cB\x{302}\0 \0\cA";
173 $sub = "e";
174 $ret = "e\0\x{300}\cA\x{301}\cB\x{302}\0";
175 $match = undef;
176 if (my($pos, $len) = $Collator->index($str, $sub)) {
177     $match = substr($str, $pos, $len);
178 }
179 ok($match, $ret);
180
181 $Collator->change(level => 1);
182
183 $str = "\0\cA\0\cAe\0\cA\x{300}\0\cAe";
184 $sub = "e";
185 $ret = "e\0\cA\x{300}\0\cA";
186 $match = undef;
187 if (my($pos, $len) = $Collator->index($str, $sub)) {
188     $match = substr($str, $pos, $len);
189 }
190 ok($match, $ret);
191
192
193 $Collator->change(%old_level);
194
195 $str = "e\x{300}";
196 $sub = "e";
197 $ret = undef;
198 $match = undef;
199 if (my($pos, $len) = $Collator->index($str, $sub)) {
200     $match = substr($str, $pos, $len);
201 }
202 ok($match, $ret);
203
204 ##############
205
206 $Collator->change(level => 1);
207
208 $str = "The Perl is a language, and the perl is an interpreter.";
209 $sub = "PERL";
210
211 $match = undef;
212 if (my($pos, $len) = $Collator->index($str, $sub, -40)) {
213     $match = substr($str, $pos, $len);
214 }
215 ok($match, "Perl");
216
217 $match = undef;
218 if (my($pos, $len) = $Collator->index($str, $sub, 4)) {
219     $match = substr($str, $pos, $len);
220 }
221 ok($match, "Perl");
222
223 $match = undef;
224 if (my($pos, $len) = $Collator->index($str, $sub, 5)) {
225     $match = substr($str, $pos, $len);
226 }
227 ok($match, "perl");
228
229 $match = undef;
230 if (my($pos, $len) = $Collator->index($str, $sub, 32)) {
231     $match = substr($str, $pos, $len);
232 }
233 ok($match, "perl");
234
235 $match = undef;
236 if (my($pos, $len) = $Collator->index($str, $sub, 33)) {
237     $match = substr($str, $pos, $len);
238 }
239 ok($match, undef);
240
241 $match = undef;
242 if (my($pos, $len) = $Collator->index($str, $sub, 100)) {
243     $match = substr($str, $pos, $len);
244 }
245 ok($match, undef);
246
247 $Collator->change(%old_level);
248
249 ##############
250
251 my @ret;
252
253 $Collator->change(level => 1);
254
255 $ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe");
256 ok($ret);
257 ok($$ret eq "P\cBe\x{300}\cB");
258
259 @ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe");
260 ok($ret[0], "P\cBe\x{300}\cB");
261
262 $str = $IsEBCDIC ? "mu\x{0059}" : "mu\x{00DF}";
263 $sub = $IsEBCDIC ? "m\x{00DC}ss" : "m\x{00FC}ss";
264
265 ($ret) = $Collator->match($str, $sub);
266 ok($ret, $str);
267
268 $str = $IsEBCDIC ? "mu\x{0059}" : "mu\x{00DF}";
269 $sub = $IsEBCDIC ? "m\x{00DC}s" : "m\x{00FC}s";
270
271 ($ret) = $Collator->match($str, $sub);
272 ok($ret, undef);
273
274 $ret = join ':', $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe");
275 ok($ret eq "P\cBe\x{300}\cB:pe:PE");
276
277 $ret = $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe");
278 ok($ret == 3);
279
280 $str = "ABCDEF";
281 $sub = "cde";
282 $ret = $Collator->match($str, $sub);
283 $str = "01234567";
284 ok($ret && $$ret, "CDE");
285
286 $str = "ABCDEF";
287 $sub = "cde";
288 ($ret) = $Collator->match($str, $sub);
289 $str = "01234567";
290 ok($ret, "CDE");
291
292
293 $Collator->change(level => 3);
294
295 $ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe");
296 ok($ret, undef);
297
298 @ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe");
299 ok(@ret == 0);
300
301 $ret = join ':', $Collator->gmatch("P\cBe\x{300}\cBrl and PERL", "pe");
302 ok($ret eq "");
303
304 $ret = $Collator->gmatch("P\cBe\x{300}\cBrl and PERL", "pe");
305 ok($ret == 0);
306
307 $ret = join ':', $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe");
308 ok($ret eq "pe");
309
310 $ret = $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe");
311 ok($ret == 1);
312
313 $str = $IsEBCDIC ? "mu\x{0059}" : "mu\x{00DF}";
314 $sub = $IsEBCDIC ? "m\x{00DC}ss" : "m\x{00FC}ss";
315
316 ($ret) = $Collator->match($str, $sub);
317 ok($ret, undef);
318
319 $Collator->change(%old_level);
320
321 ##############
322
323 $Collator->change(level => 1);
324
325 sub strreverse { scalar reverse shift }
326
327 $str = "P\cBe\x{300}\cBrl and PERL.";
328 $ret = $Collator->subst($str, "perl", 'Camel');
329 ok($ret, 1);
330 ok($str, "Camel and PERL.");
331
332 $str = "P\cBe\x{300}\cBrl and PERL.";
333 $ret = $Collator->subst($str, "perl", \&strreverse);
334 ok($ret, 1);
335 ok($str, "lr\cB\x{300}e\cBP and PERL.");
336
337 $str = "P\cBe\x{300}\cBrl and PERL.";
338 $ret = $Collator->gsubst($str, "perl", 'Camel');
339 ok($ret, 2);
340 ok($str, "Camel and Camel.");
341
342 $str = "P\cBe\x{300}\cBrl and PERL.";
343 $ret = $Collator->gsubst($str, "perl", \&strreverse);
344 ok($ret, 2);
345 ok($str, "lr\cB\x{300}e\cBP and LREP.");
346
347 $str = "Camel donkey zebra came\x{301}l CAMEL horse cAm\0E\0L...";
348 $Collator->gsubst($str, "camel", sub { "<b>$_[0]</b>" });
349 ok($str, "<b>Camel</b> donkey zebra <b>came\x{301}l</b> "
350         . "<b>CAMEL</b> horse <b>cAm\0E\0L</b>...");
351
352 # http://www.xray.mpe.mpg.de/mailing-lists/perl-unicode/2010-09/msg00014.html
353 # when the substring includes an ignorable element like a space...
354
355 $str = "Camel donkey zebra came\x{301}l CAMEL horse cAm\0E\0L...";
356 $Collator->gsubst($str, "camel horse", sub { "<b>$_[0]</b>" });
357 ok($str, "Camel donkey zebra came\x{301}l <b>CAMEL horse</b> cAm\0E\0L...");
358
359 $str = "Camel donkey zebra camex{301}l CAMEL horse cAmEL-horse...";
360 $Collator->gsubst($str, "camel horse", sub { "=$_[0]=" });
361 ok($str, "Camel donkey zebra camex{301}l =CAMEL horse= =cAmEL-horse=...");
362
363 $str = "Camel donkey zebra camex{301}l CAMEL horse cAmEL-horse...";
364 $Collator->gsubst($str, "camel-horse", sub { "=$_[0]=" });
365 ok($str, "Camel donkey zebra camex{301}l =CAMEL horse= =cAmEL-horse=...");
366
367 $str = "Camel donkey zebra camex{301}l CAMEL horse cAmEL-horse...";
368 $Collator->gsubst($str, "camelhorse", sub { "=$_[0]=" });
369 ok($str, "Camel donkey zebra camex{301}l =CAMEL horse= =cAmEL-horse=...");
370
371 $str = "Camel donkey zebra camex{301}l CAMEL horse cAmEL-horse...";
372 $Collator->gsubst($str, "  ca  mel  hor  se  ", sub { "=$_[0]=" });
373 ok($str, "Camel donkey zebra camex{301}l =CAMEL horse= =cAmEL-horse=...");
374
375 $str = "Camel donkey zebra camex{301}l CAMEL horse cAmEL-horse...";
376 $Collator->gsubst($str, "ca\x{300}melho\x{302}rse", sub { "=$_[0]=" });
377 ok($str, "Camel donkey zebra camex{301}l =CAMEL horse= =cAmEL-horse=...");
378
379 $Collator->change(level => 3);
380
381 $str = "P\cBe\x{300}\cBrl and PERL.";
382 $ret = $Collator->subst($str, "perl", "Camel");
383 ok(! $ret);
384 ok($str, "P\cBe\x{300}\cBrl and PERL.");
385
386 $str = "P\cBe\x{300}\cBrl and PERL.";
387 $ret = $Collator->subst($str, "perl", \&strreverse);
388 ok(! $ret);
389 ok($str, "P\cBe\x{300}\cBrl and PERL.");
390
391 $str = "P\cBe\x{300}\cBrl and PERL.";
392 $ret = $Collator->gsubst($str, "perl", "Camel");
393 ok($ret, 0);
394 ok($str, "P\cBe\x{300}\cBrl and PERL.");
395
396 $str = "P\cBe\x{300}\cBrl and PERL.";
397 $ret = $Collator->gsubst($str, "perl", \&strreverse);
398 ok($ret, 0);
399 ok($str, "P\cBe\x{300}\cBrl and PERL.");
400
401 $Collator->change(%old_level);
402
403 ##############
404
405 $str = "Perl and Camel";
406 $ret = $Collator->gsubst($str, "\cA\cA\0", "AB");
407 ok($ret, 15);
408 ok($str, "ABPABeABrABlAB ABaABnABdAB ABCABaABmABeABlAB");
409
410 $str = '';
411 $ret = $Collator->subst($str, "", "ABC");
412 ok($ret, 1);
413 ok($str, "ABC");
414
415 $str = '';
416 $ret = $Collator->gsubst($str, "", "ABC");
417 ok($ret, 1);
418 ok($str, "ABC");
419
420 $str = 'PPPPP';
421 $ret = $Collator->gsubst($str, 'PP', "ABC");
422 ok($ret, 2);
423 ok($str, "ABCABCP");
424
425 ##############
426
427 # Shifted; ignorable after variable
428
429 ($ret) = $Collator->match("A?\x{300}!\x{301}\x{344}B\x{315}", "?!");
430 ok($ret, "?\x{300}!\x{301}\x{344}");
431
432 $Collator->change(alternate => 'Non-ignorable');
433
434 ($ret) = $Collator->match("A?\x{300}!\x{301}B\x{315}", "?!");
435 ok($ret, undef);
436