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