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