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 => 22 };
9 ok(1); # If we made it this far, we're ok.
11 #########################
13 my $UCA = Unicode::Collate->new(
15 normalization => undef,
18 ok(ref $UCA, "Unicode::Collate");
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($UCA->cmp("A$acute", $A_acute), -1);
34 ok($UCA->cmp("", ""), 0);
35 ok($UCA->cmp("", "perl"), -1);
37 eval "use Unicode::Normalize";
40 my $NFD = Unicode::Collate->new(
43 ok($NFD->cmp("A$acute", $A_acute), 0);
49 my $tr = Unicode::Collate->new(
51 normalization => undef,
52 ignoreName => qr/^(?:HANGUL|HIRAGANA|KATAKANA|BOPOMOFO)$/,
54 0063 0068 ; [.0893.0020.0002.0063] # "ch" in traditional Spanish
55 0043 0068 ; [.0893.0020.0008.0043] # "Ch" in traditional Spanish
61 qw/ acha aca ada acia acka /
64 qw/ aca acia acka acha ada /
70 qw/ acha aca ada acia acka /
73 qw/ aca acha acia acka ada /
77 my $old_level = $UCA->{level};
78 my $hiragana = "\x{3042}\x{3044}";
79 my $katakana = "\x{30A2}\x{30A4}";
83 ok( $UCA->cmp("ABC","abc"), 0);
84 ok( $UCA->cmp($hiragana, $katakana), 0);
86 $UCA->{level} = $old_level;
88 $UCA->{katakana_before_hiragana} = 1;
90 ok( $UCA->cmp("abc", "ABC"), -1);
91 ok( $UCA->cmp($hiragana, $katakana), 1);
93 $UCA->{upper_before_lower} = 1;
95 ok( $UCA->cmp("abc", "ABC"), 1);
96 ok( $UCA->cmp($hiragana, $katakana), 1);
98 $UCA->{katakana_before_hiragana} = 0;
100 ok( $UCA->cmp("abc", "ABC"), 1);
101 ok( $UCA->cmp($hiragana, $katakana), -1);
103 $UCA->{upper_before_lower} = 0;
105 ok( $UCA->cmp("abc", "ABC"), -1);
106 ok( $UCA->cmp($hiragana, $katakana), -1);
108 my $ign = Unicode::Collate->new(
110 normalization => undef,
111 ignoreChar => qr/^[ae]$/,
114 ok( $ign->cmp("element","lament"), 0);
118 my $orig = "This is a Perl book.";
122 my $ret = "This is a camel book.";
125 if(my @tmp = $UCA->index($str, $sub)){
126 substr($str, $tmp[0], $tmp[1], $rep);
131 $UCA->{level} = $old_level;
134 if(my @tmp = $UCA->index($str, $sub)){
135 substr($str, $tmp[0], $tmp[1], $rep);