lib/Unicode/Collate/t/test.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl test.pl'
   3
   4 #########################
   5
   6 use Test;
   7 BEGIN { plan tests => 50 };
   8 use Unicode::Collate;
   9 ok(1); # If we made it this far, we're ok.
  10
  11 #########################
  12
  13 my $Collator = Unicode::Collate->new(
  14   table => 'keys.txt',
  15   normalization => undef,
  16 );
  17
  18 ok(ref $Collator, "Unicode::Collate");
  19
  20 ok(
  21   join(':', $Collator->sort(
  22     qw/ lib strict Carp ExtUtils CGI Time warnings Math overload Pod CPAN /
  23   ) ),
  24   join(':',
  25     qw/ Carp CGI CPAN ExtUtils lib Math overload Pod strict Time warnings /
  26   ),
  27 );
  28
  29 my $A_acute = pack('U', 0x00C1);
  30 my $acute   = pack('U', 0x0301);
  31
  32 ok($Collator->cmp("A$acute", $A_acute), -1);
  33
  34 ok($Collator->cmp("", ""), 0);
  35 ok(! $Collator->ne("", "") );
  36 ok(  $Collator->eq("", "") );
  37
  38 ok($Collator->cmp("", "perl"), -1);
  39
  40 eval "use Unicode::Normalize";
  41
  42 if(!$@){
  43   my $NFD = Unicode::Collate->new(
  44     table => 'keys.txt',
  45   );
  46   ok($NFD->cmp("A$acute", $A_acute), 0);
  47 }
  48 else{
  49   ok(1);
  50 }
  51
  52 my $tr = Unicode::Collate->new(
  53   table => 'keys.txt',
  54   normalization => undef,
  55   ignoreName => qr/^(?:HANGUL|HIRAGANA|KATAKANA|BOPOMOFO)$/,
  56   entry => <<'ENTRIES',
  57 0063 0068 ; [.0893.0020.0002.0063]  # "ch" in traditional Spanish
  58 0043 0068 ; [.0893.0020.0008.0043]  # "Ch" in traditional Spanish
  59 00DF ; [.09F3.0154.0004.00DF] [.09F3.0020.0004.00DF] # eszet in Germany
  60 ENTRIES
  61 );
  62
  63 ok(
  64   join(':', $tr->sort(
  65     qw/ acha aca ada acia acka /
  66   ) ),
  67   join(':',
  68     qw/ aca acia acka acha ada /
  69   ),
  70 );
  71
  72 ok(
  73   join(':', $Collator->sort(
  74     qw/ acha aca ada acia acka /
  75   ) ),
  76   join(':',
  77     qw/ aca acha acia acka ada /
  78   ),
  79 );
  80
  81 my $old_level = $Collator->{level};
  82 my $hiragana = "\x{3042}\x{3044}";
  83 my $katakana = "\x{30A2}\x{30A4}";
  84
  85 $Collator->{level} = 2;
  86
  87 ok( $Collator->cmp("ABC","abc"), 0);
  88 ok( $Collator->eq("ABC","abc") );
  89 ok( $Collator->le("ABC","abc") );
  90 ok( $Collator->cmp($hiragana, $katakana), 0);
  91 ok( $Collator->eq($hiragana, $katakana) );
  92 ok( $Collator->ge($hiragana, $katakana) );
  93
  94 # hangul
  95 ok( $Collator->eq("a\x{AC00}b", "a\x{1100}\x{1161}b") );
  96 ok( $Collator->eq("a\x{AE00}b", "a\x{1100}\x{1173}\x{11AF}b") );
  97 ok( $Collator->gt("a\x{AE00}b", "a\x{1100}\x{1173}b\x{11AF}") );
  98 ok( $Collator->lt("a\x{AC00}b", "a\x{AE00}b") );
  99 ok( $Collator->gt("a\x{D7A3}b", "a\x{C544}b") );
 100 ok( $Collator->lt("a\x{C544}b", "a\x{30A2}b") ); # hangul < hiragana
 101
 102 $Collator->{level} = $old_level;
 103
 104 $Collator->{katakana_before_hiragana} = 1;
 105
 106 ok( $Collator->cmp("abc", "ABC"), -1);
 107 ok( $Collator->ne("abc", "ABC") );
 108 ok( $Collator->lt("abc", "ABC") );
 109 ok( $Collator->le("abc", "ABC") );
 110 ok( $Collator->cmp($hiragana, $katakana), 1);
 111 ok( $Collator->ne($hiragana, $katakana) );
 112 ok( $Collator->gt($hiragana, $katakana) );
 113 ok( $Collator->ge($hiragana, $katakana) );
 114
 115 $Collator->{upper_before_lower} = 1;
 116
 117 ok( $Collator->cmp("abc", "ABC"), 1);
 118 ok( $Collator->ge("abc", "ABC"), 1);
 119 ok( $Collator->gt("abc", "ABC"), 1);
 120 ok( $Collator->cmp($hiragana, $katakana), 1);
 121 ok( $Collator->ge($hiragana, $katakana), 1);
 122 ok( $Collator->gt($hiragana, $katakana), 1);
 123
 124 $Collator->{katakana_before_hiragana} = 0;
 125
 126 ok( $Collator->cmp("abc", "ABC"), 1);
 127 ok( $Collator->cmp($hiragana, $katakana), -1);
 128
 129 $Collator->{upper_before_lower} = 0;
 130
 131 ok( $Collator->cmp("abc", "ABC"), -1);
 132 ok( $Collator->le("abc", "ABC") );
 133 ok( $Collator->cmp($hiragana, $katakana), -1);
 134 ok( $Collator->lt($hiragana, $katakana) );
 135
 136 my $ign = Unicode::Collate->new(
 137   table => 'keys.txt',
 138   normalization => undef,
 139   ignoreChar => qr/^[ae]$/,
 140 );
 141
 142 ok( $ign->cmp("element","lament"), 0);
 143
 144 $Collator->{level} = 2;
 145
 146 my $str;
 147
 148 my $orig = "This is a Perl book.";
 149 my $sub = "PERL";
 150 my $rep = "camel";
 151 my $ret = "This is a camel book.";
 152
 153 $str = $orig;
 154 if(my($pos,$len) = $Collator->index($str, $sub)){
 155   substr($str, $pos, $len, $rep);
 156 }
 157
 158 ok($str, $ret);
 159
 160 $Collator->{level} = $old_level;
 161
 162 $str = $orig;
 163 if(my($pos,$len) = $Collator->index($str, $sub)){
 164   substr($str, $pos, $len, $rep);
 165 }
 166
 167 ok($str, $orig);
 168
 169 $tr->{level} = 1;
 170
 171 $str = "Ich mu\x{00DF} studieren.";
 172 $sub = "m\x{00FC}ss";
 173 my $match = undef;
 174 if(my($pos, $len) = $tr->index($str, $sub)){
 175     $match = substr($str, $pos, $len);
 176 }
 177 ok($match, "mu\x{00DF}");
 178
 179 $tr->{level} = $old_level;
 180
 181 $str = "Ich mu\x{00DF} studieren.";
 182 $sub = "m\x{00FC}ss";
 183 $match = undef;
 184 if(my($pos, $len) = $tr->index($str, $sub)){
 185     $match = substr($str, $pos, $len);
 186 }
 187 ok($match, undef);
 188
 189 $match = undef;
 190 if(my($pos,$len) = $Collator->index("", "")){
 191     $match = substr("", $pos, $len);
 192 }
 193 ok($match, "");
 194
 195 $match = undef;
 196 if(my($pos,$len) = $Collator->index("", "abc")){
 197     $match = substr("", $pos, $len);
 198 }
 199 ok($match, undef);
 200