1 2BEGIN { 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 14use Test; 15BEGIN { plan tests => 65 }; 16 17use strict; 18use warnings; 19use Unicode::Collate; 20 21our $IsEBCDIC = ord("A") != 0x41; 22 23######################### 24 25ok(1); 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 339$str = "Camel donkey zebra came\x{301}l CAMEL horse cAm\0E\0L..."; 340$Collator->gsubst($str, "camel", sub { "<b>$_[0]</b>" }); 341ok($str, "<b>Camel</b> donkey zebra <b>came\x{301}l</b> " 342 . "<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"); 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); 401 402