Commit | Line | Data |
4d36a948 |
1 | |
2 | BEGIN { |
9f1f04a1 |
3 | unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) { |
4 | print "1..0 # Unicode::Collate " . |
5 | "cannot stringify a Unicode code point\n"; |
4d36a948 |
6 | exit 0; |
7 | } |
8 | } |
9 | |
10 | BEGIN { |
11 | if ($ENV{PERL_CORE}) { |
12 | chdir('t') if -d 't'; |
63c6dcc1 |
13 | @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib); |
4d36a948 |
14 | } |
15 | } |
16 | |
17 | use Test; |
18 | BEGIN { plan tests => 65 }; |
19 | use Unicode::Collate; |
20 | |
21 | our $IsEBCDIC = ord("A") != 0x41; |
22 | |
23 | ######################### |
24 | |
25 | ok(1); # If we made it this far, we're ok. |
26 | |
27 | my $Collator = Unicode::Collate->new( |
28 | table => 'keys.txt', |
29 | normalization => undef, |
30 | ); |
31 | |
32 | ############## |
33 | |
34 | my %old_level = $Collator->change(level => 2); |
35 | |
36 | my $str; |
37 | |
38 | my $orig = "This is a Perl book."; |
39 | my $sub = "PERL"; |
40 | my $rep = "camel"; |
41 | my $ret = "This is a camel book."; |
42 | |
43 | $str = $orig; |
44 | if (my($pos,$len) = $Collator->index($str, $sub)) { |
45 | substr($str, $pos, $len, $rep); |
46 | } |
47 | |
48 | ok($str, $ret); |
49 | |
50 | $Collator->change(%old_level); |
51 | |
52 | $str = $orig; |
53 | if (my($pos,$len) = $Collator->index($str, $sub)) { |
54 | substr($str, $pos, $len, $rep); |
55 | } |
56 | |
57 | ok($str, $orig); |
58 | |
59 | ############## |
60 | |
61 | my $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; |
69 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
70 | $match = substr($str, $pos, $len); |
71 | } |
72 | ok($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; |
78 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
79 | $match = substr($str, $pos, $len); |
80 | } |
81 | ok($match, $ret); |
82 | |
83 | $Collator->change(level => 2); |
84 | |
85 | $str = "Pe\x{300}rl"; |
86 | $sub = "pe"; |
87 | $ret = undef; |
88 | $match = undef; |
89 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
90 | $match = substr($str, $pos, $len); |
91 | } |
92 | ok($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; |
98 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
99 | $match = substr($str, $pos, $len); |
100 | } |
101 | ok($match, $ret); |
102 | |
103 | $str = "Pe\x{300}rl"; |
104 | $sub = "pe\x{300}"; |
105 | $ret = "Pe\x{300}"; |
106 | $match = undef; |
107 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
108 | $match = substr($str, $pos, $len); |
109 | } |
110 | ok($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; |
116 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
117 | $match = substr($str, $pos, $len); |
118 | } |
119 | ok($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; |
135 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
136 | $match = substr($str, $pos, $len); |
137 | } |
138 | ok($match, $ret); |
139 | |
140 | $Collator->change(%old_level); |
141 | |
142 | $match = undef; |
143 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
144 | $match = substr($str, $pos, $len); |
145 | } |
146 | ok($match, undef); |
147 | |
148 | $match = undef; |
149 | if (my($pos,$len) = $Collator->index("", "")) { |
150 | $match = substr("", $pos, $len); |
151 | } |
152 | ok($match, ""); |
153 | |
154 | $match = undef; |
155 | if (my($pos,$len) = $Collator->index("", "abc")) { |
156 | $match = substr("", $pos, $len); |
157 | } |
158 | ok($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; |
168 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
169 | $match = substr($str, $pos, $len); |
170 | } |
171 | ok($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; |
179 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
180 | $match = substr($str, $pos, $len); |
181 | } |
182 | ok($match, $ret); |
183 | |
184 | |
185 | $Collator->change(%old_level); |
186 | |
187 | $str = "e\x{300}"; |
188 | $sub = "e"; |
189 | $ret = undef; |
190 | $match = undef; |
191 | if (my($pos, $len) = $Collator->index($str, $sub)) { |
192 | $match = substr($str, $pos, $len); |
193 | } |
194 | ok($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; |
204 | if (my($pos, $len) = $Collator->index($str, $sub, -40)) { |
205 | $match = substr($str, $pos, $len); |
206 | } |
207 | ok($match, "Perl"); |
208 | |
209 | $match = undef; |
210 | if (my($pos, $len) = $Collator->index($str, $sub, 4)) { |
211 | $match = substr($str, $pos, $len); |
212 | } |
213 | ok($match, "Perl"); |
214 | |
215 | $match = undef; |
216 | if (my($pos, $len) = $Collator->index($str, $sub, 5)) { |
217 | $match = substr($str, $pos, $len); |
218 | } |
219 | ok($match, "perl"); |
220 | |
221 | $match = undef; |
222 | if (my($pos, $len) = $Collator->index($str, $sub, 32)) { |
223 | $match = substr($str, $pos, $len); |
224 | } |
225 | ok($match, "perl"); |
226 | |
227 | $match = undef; |
228 | if (my($pos, $len) = $Collator->index($str, $sub, 33)) { |
229 | $match = substr($str, $pos, $len); |
230 | } |
231 | ok($match, undef); |
232 | |
233 | $match = undef; |
234 | if (my($pos, $len) = $Collator->index($str, $sub, 100)) { |
235 | $match = substr($str, $pos, $len); |
236 | } |
237 | ok($match, undef); |
238 | |
239 | $Collator->change(%old_level); |
240 | |
241 | ############## |
242 | |
243 | my @ret; |
244 | |
245 | $Collator->change(level => 1); |
246 | |
247 | $ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe"); |
248 | ok($ret); |
249 | ok($$ret eq "P\cBe\x{300}\cB"); |
250 | |
251 | @ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe"); |
252 | ok($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); |
258 | ok($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); |
264 | ok($ret, undef); |
265 | |
266 | $ret = join ':', $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe"); |
267 | ok($ret eq "P\cBe\x{300}\cB:pe:PE"); |
268 | |
269 | $ret = $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe"); |
270 | ok($ret == 3); |
271 | |
272 | $str = "ABCDEF"; |
273 | $sub = "cde"; |
274 | $ret = $Collator->match($str, $sub); |
275 | $str = "01234567"; |
276 | ok($ret && $$ret, "CDE"); |
277 | |
278 | $str = "ABCDEF"; |
279 | $sub = "cde"; |
280 | ($ret) = $Collator->match($str, $sub); |
281 | $str = "01234567"; |
282 | ok($ret, "CDE"); |
283 | |
284 | |
285 | $Collator->change(level => 3); |
286 | |
287 | $ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe"); |
288 | ok($ret, undef); |
289 | |
290 | @ret = $Collator->match("P\cBe\x{300}\cBrl and PERL", "pe"); |
291 | ok(@ret == 0); |
292 | |
293 | $ret = join ':', $Collator->gmatch("P\cBe\x{300}\cBrl and PERL", "pe"); |
294 | ok($ret eq ""); |
295 | |
296 | $ret = $Collator->gmatch("P\cBe\x{300}\cBrl and PERL", "pe"); |
297 | ok($ret == 0); |
298 | |
299 | $ret = join ':', $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe"); |
300 | ok($ret eq "pe"); |
301 | |
302 | $ret = $Collator->gmatch("P\cBe\x{300}\cBrl, perl, and PERL", "pe"); |
303 | ok($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); |
309 | ok($ret, undef); |
310 | |
311 | $Collator->change(%old_level); |
312 | |
313 | ############## |
314 | |
315 | $Collator->change(level => 1); |
316 | |
317 | sub strreverse { scalar reverse shift } |
318 | |
319 | $str = "P\cBe\x{300}\cBrl and PERL."; |
320 | $ret = $Collator->subst($str, "perl", 'Camel'); |
321 | ok($ret, 1); |
322 | ok($str, "Camel and PERL."); |
323 | |
324 | $str = "P\cBe\x{300}\cBrl and PERL."; |
325 | $ret = $Collator->subst($str, "perl", \&strreverse); |
326 | ok($ret, 1); |
327 | ok($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'); |
331 | ok($ret, 2); |
332 | ok($str, "Camel and Camel."); |
333 | |
334 | $str = "P\cBe\x{300}\cBrl and PERL."; |
335 | $ret = $Collator->gsubst($str, "perl", \&strreverse); |
336 | ok($ret, 2); |
337 | ok($str, "lr\cB\x{300}e\cBP and LREP."); |
338 | |
339 | $str = "Camel ass came\x{301}l CAMEL horse cAm\0E\0L..."; |
340 | $Collator->gsubst($str, "camel", sub { "<b>$_[0]</b>" }); |
341 | ok($str, |
342 | "<b>Camel</b> ass <b>came\x{301}l</b> <b>CAMEL</b> horse <b>cAm\0E\0L</b>..."); |
343 | |
344 | $Collator->change(level => 3); |
345 | |
346 | $str = "P\cBe\x{300}\cBrl and PERL."; |
347 | $ret = $Collator->subst($str, "perl", "Camel"); |
348 | ok(! $ret); |
349 | ok($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); |
353 | ok(! $ret); |
354 | ok($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"); |
358 | ok($ret, 0); |
359 | ok($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); |
363 | ok($ret, 0); |
364 | ok($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"); |
372 | ok($ret, 15); |
373 | ok($str, "ABPABeABrABlAB ABaABnABdAB ABCABaABmABeABlAB"); |
374 | |
375 | $str = ''; |
376 | $ret = $Collator->subst($str, "", "ABC"); |
377 | ok($ret, 1); |
378 | ok($str, "ABC"); |
379 | |
380 | $str = ''; |
381 | $ret = $Collator->gsubst($str, "", "ABC"); |
382 | ok($ret, 1); |
383 | ok($str, "ABC"); |
384 | |
385 | $str = 'PPPPP'; |
386 | $ret = $Collator->gsubst($str, 'PP', "ABC"); |
387 | ok($ret, 2); |
388 | ok($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}", "?!"); |
395 | ok($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}", "?!"); |
400 | ok($ret, undef); |