lib/Unicode/Collate/t/index.t

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