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