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'
4 #########################
7 BEGIN { plan tests => 54 };
9 ok(1); # If we made it this far, we're ok.
11 #########################
13 my $Collator = Unicode::Collate->new(
15 normalization => undef,
18 ok(ref $Collator, "Unicode::Collate");
21 join(':', $Collator->sort(
22 qw/ lib strict Carp ExtUtils CGI Time warnings Math overload Pod CPAN /
25 qw/ Carp CGI CPAN ExtUtils lib Math overload Pod strict Time warnings /
29 my $A_acute = pack('U', 0x00C1);
30 my $acute = pack('U', 0x0301);
32 ok($Collator->cmp("A$acute", $A_acute), -1);
34 ok($Collator->cmp("", ""), 0);
35 ok(! $Collator->ne("", "") );
36 ok( $Collator->eq("", "") );
38 ok($Collator->cmp("", "perl"), -1);
40 eval "use Unicode::Normalize";
43 my $NFD = Unicode::Collate->new(
46 0430 ; [.0B01.0020.0002.0430] # CYRILLIC SMALL LETTER A
47 0410 ; [.0B01.0020.0008.0410] # CYRILLIC CAPITAL LETTER A
48 04D3 ; [.0B09.0020.0002.04D3] # CYRILLIC SMALL LETTER A WITH DIAERESIS
49 0430 0308 ; [.0B09.0020.0002.04D3] # CYRILLIC SMALL LETTER A WITH DIAERESIS
50 04D3 ; [.0B09.0020.0002.04D3] # CYRILLIC SMALL LETTER A WITH DIAERESIS
51 0430 0308 ; [.0B09.0020.0002.04D3] # CYRILLIC SMALL LETTER A WITH DIAERESIS
52 04D2 ; [.0B09.0020.0008.04D2] # CYRILLIC CAPITAL LETTER A WITH DIAERESIS
53 0410 0308 ; [.0B09.0020.0008.04D2] # CYRILLIC CAPITAL LETTER A WITH DIAERESIS
54 0430 3099 ; [.0B10.0020.0002.04D3] # A WITH KATAKANA VOICED
55 0430 3099 0308 ; [.0B11.0020.0002.04D3] # A WITH KATAKANA VOICED, DIAERESIS
58 ok($NFD->eq("A$acute", $A_acute));
59 ok($NFD->eq("\x{4D3}\x{325}", "\x{430}\x{308}\x{325}"));
60 ok($NFD->lt("\x{430}\x{308}A", "\x{430}\x{308}B"));
61 ok($NFD->lt("\x{430}\x{3099}B", "\x{430}\x{308}\x{3099}A"));
62 ok($NFD->eq("\x{0430}\x{3099}\x{309A}\x{0308}",
63 "\x{0430}\x{309A}\x{3099}\x{0308}") );
73 my $tr = Unicode::Collate->new(
75 normalization => undef,
76 ignoreName => qr/^(?:HANGUL|HIRAGANA|KATAKANA|BOPOMOFO)$/,
78 0063 0068 ; [.0893.0020.0002.0063] # "ch" in traditional Spanish
79 0043 0068 ; [.0893.0020.0008.0043] # "Ch" in traditional Spanish
80 00DF ; [.09F3.0154.0004.00DF] [.09F3.0020.0004.00DF] # eszet in Germany
86 qw/ acha aca ada acia acka /
89 qw/ aca acia acka acha ada /
94 join(':', $Collator->sort(
95 qw/ acha aca ada acia acka /
98 qw/ aca acha acia acka ada /
102 my $old_level = $Collator->{level};
103 my $hiragana = "\x{3042}\x{3044}";
104 my $katakana = "\x{30A2}\x{30A4}";
106 $Collator->{level} = 2;
108 ok( $Collator->cmp("ABC","abc"), 0);
109 ok( $Collator->eq("ABC","abc") );
110 ok( $Collator->le("ABC","abc") );
111 ok( $Collator->cmp($hiragana, $katakana), 0);
112 ok( $Collator->eq($hiragana, $katakana) );
113 ok( $Collator->ge($hiragana, $katakana) );
116 ok( $Collator->eq("a\x{AC00}b", "a\x{1100}\x{1161}b") );
117 ok( $Collator->eq("a\x{AE00}b", "a\x{1100}\x{1173}\x{11AF}b") );
118 ok( $Collator->gt("a\x{AE00}b", "a\x{1100}\x{1173}b\x{11AF}") );
119 ok( $Collator->lt("a\x{AC00}b", "a\x{AE00}b") );
120 ok( $Collator->gt("a\x{D7A3}b", "a\x{C544}b") );
121 ok( $Collator->lt("a\x{C544}b", "a\x{30A2}b") ); # hangul < hiragana
123 $Collator->{level} = $old_level;
125 $Collator->{katakana_before_hiragana} = 1;
127 ok( $Collator->cmp("abc", "ABC"), -1);
128 ok( $Collator->ne("abc", "ABC") );
129 ok( $Collator->lt("abc", "ABC") );
130 ok( $Collator->le("abc", "ABC") );
131 ok( $Collator->cmp($hiragana, $katakana), 1);
132 ok( $Collator->ne($hiragana, $katakana) );
133 ok( $Collator->gt($hiragana, $katakana) );
134 ok( $Collator->ge($hiragana, $katakana) );
136 $Collator->{upper_before_lower} = 1;
138 ok( $Collator->cmp("abc", "ABC"), 1);
139 ok( $Collator->ge("abc", "ABC"), 1);
140 ok( $Collator->gt("abc", "ABC"), 1);
141 ok( $Collator->cmp($hiragana, $katakana), 1);
142 ok( $Collator->ge($hiragana, $katakana), 1);
143 ok( $Collator->gt($hiragana, $katakana), 1);
145 $Collator->{katakana_before_hiragana} = 0;
147 ok( $Collator->cmp("abc", "ABC"), 1);
148 ok( $Collator->cmp($hiragana, $katakana), -1);
150 $Collator->{upper_before_lower} = 0;
152 ok( $Collator->cmp("abc", "ABC"), -1);
153 ok( $Collator->le("abc", "ABC") );
154 ok( $Collator->cmp($hiragana, $katakana), -1);
155 ok( $Collator->lt($hiragana, $katakana) );
157 my $ign = Unicode::Collate->new(
159 normalization => undef,
160 ignoreChar => qr/^[ae]$/,
163 ok( $ign->cmp("element","lament"), 0);
165 $Collator->{level} = 2;
169 my $orig = "This is a Perl book.";
172 my $ret = "This is a camel book.";
175 if(my($pos,$len) = $Collator->index($str, $sub)){
176 substr($str, $pos, $len, $rep);
181 $Collator->{level} = $old_level;
184 if(my($pos,$len) = $Collator->index($str, $sub)){
185 substr($str, $pos, $len, $rep);
192 $str = "Ich mu\x{00DF} studieren.";
193 $sub = "m\x{00FC}ss";
195 if(my($pos, $len) = $tr->index($str, $sub)){
196 $match = substr($str, $pos, $len);
198 ok($match, "mu\x{00DF}");
200 $tr->{level} = $old_level;
202 $str = "Ich mu\x{00DF} studieren.";
203 $sub = "m\x{00FC}ss";
205 if(my($pos, $len) = $tr->index($str, $sub)){
206 $match = substr($str, $pos, $len);
211 if(my($pos,$len) = $Collator->index("", "")){
212 $match = substr("", $pos, $len);
217 if(my($pos,$len) = $Collator->index("", "abc")){
218 $match = substr("", $pos, $len);