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