lib/Unicode/Collate/t/variable.t

   1
   2 BEGIN {
   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
  14 use Test;
  15 BEGIN { plan tests => 37 };
  16
  17 use strict;
  18 use warnings;
  19 use Unicode::Collate;
  20
  21 ok(1);
  22
  23 #########################
  24
  25 sub _pack_U   { Unicode::Collate::pack_U(@_) }
  26 sub _unpack_U { Unicode::Collate::unpack_U(@_) }
  27
  28 my $A_acute = _pack_U(0xC1);
  29 my $acute   = _pack_U(0x0301);
  30
  31 my $Collator = Unicode::Collate->new(
  32   table => 'keys.txt',
  33   normalization => undef,
  34 );
  35
  36 my %origVar = $Collator->change(variable => 'Blanked');
  37
  38 ok($Collator->lt("death", "de luge"));
  39 ok($Collator->lt("de luge", "de-luge"));
  40 ok($Collator->lt("de-luge", "deluge"));
  41 ok($Collator->lt("deluge", "de\x{2010}luge"));
  42 ok($Collator->lt("deluge", "de Luge"));
  43
  44 $Collator->change(variable => 'Non-ignorable');
  45
  46 ok($Collator->lt("de luge", "de Luge"));
  47 ok($Collator->lt("de Luge", "de-luge"));
  48 ok($Collator->lt("de-Luge", "de\x{2010}luge"));
  49 ok($Collator->lt("de-luge", "death"));
  50 ok($Collator->lt("death", "deluge"));
  51
  52 $Collator->change(variable => 'Shifted');
  53
  54 ok($Collator->lt("death", "de luge"));
  55 ok($Collator->lt("de luge", "de-luge"));
  56 ok($Collator->lt("de-luge", "deluge"));
  57 ok($Collator->lt("deluge", "de Luge"));
  58 ok($Collator->lt("de Luge", "deLuge"));
  59
  60 $Collator->change(variable => 'Shift-Trimmed');
  61
  62 ok($Collator->lt("death", "deluge"));
  63 ok($Collator->lt("deluge", "de luge"));
  64 ok($Collator->lt("de luge", "de-luge"));
  65 ok($Collator->lt("de-luge", "deLuge"));
  66 ok($Collator->lt("deLuge", "de Luge"));
  67
  68 $Collator->change(%origVar);
  69
  70 ok($Collator->{variable}, 'shifted');
  71
  72 ##############
  73
  74 # ignorable after variable
  75
  76 # Shifted;
  77 ok($Collator->eq("?\x{300}!\x{301}\x{315}", "?!"));
  78 ok($Collator->eq("?\x{300}A\x{301}", "?$A_acute"));
  79 ok($Collator->eq("?\x{300}", "?"));
  80 ok($Collator->eq("?\x{344}", "?")); # U+0344 has two CEs.
  81
  82 $Collator->change(level => 3);
  83 ok($Collator->eq("\cA", "?"));
  84
  85 $Collator->change(variable => 'blanked', level => 4);
  86 ok($Collator->eq("?\x{300}!\x{301}\x{315}", "?!"));
  87 ok($Collator->eq("?\x{300}A\x{301}", "?$A_acute"));
  88 ok($Collator->eq("?\x{300}", "?"));
  89 ok($Collator->eq("?\x{344}", "?")); # U+0344 has two CEs.
  90
  91 $Collator->change(level => 3);
  92 ok($Collator->eq("\cA", "?"));
  93
  94 $Collator->change(variable => 'Non-ignorable', level => 4);
  95
  96 ok($Collator->lt("?\x{300}", "?!"));
  97 ok($Collator->gt("?\x{300}A$acute", "?$A_acute"));
  98 ok($Collator->gt("?\x{300}", "?"));
  99 ok($Collator->gt("?\x{344}", "?"));
 100
 101 $Collator->change(level => 3);
 102 ok($Collator->lt("\cA", "?"));
 103
 104 $Collator->change(variable => 'Shifted', level => 4);
 105