| |
| BEGIN { |
| unless ("A" eq pack('U', 0x41)) { |
| print "1..0 # Unicode::Collate " . |
| "cannot stringify a Unicode code point\n"; |
| exit 0; |
| } |
| if ($ENV{PERL_CORE}) { |
| chdir('t') if -d 't'; |
| @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib); |
| } |
| } |
| |
| use strict; |
| use warnings; |
| BEGIN { $| = 1; print "1..35\n"; } |
| my $count = 0; |
| sub ok ($;$) { |
| my $p = my $r = shift; |
| if (@_) { |
| my $x = shift; |
| $p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x; |
| } |
| print $p ? "ok" : "not ok", ' ', ++$count, "\n"; |
| } |
| |
| use Unicode::Collate; |
| |
| ok(1); |
| |
| ######################### |
| |
| ##### 2..6 |
| |
| my $all_undef_8 = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideCJK => undef, |
| overrideHangul => undef, |
| UCA_Version => 8, |
| ); |
| |
| # All in the Unicode code point order. |
| # No hangul decomposition. |
| |
| ok($all_undef_8->lt("\x{3402}", "\x{4E00}")); |
| ok($all_undef_8->lt("\x{4DFF}", "\x{4E00}")); |
| ok($all_undef_8->lt("\x{4E00}", "\x{AC00}")); |
| ok($all_undef_8->gt("\x{AC00}", "\x{1100}\x{1161}")); |
| ok($all_undef_8->gt("\x{AC00}", "\x{ABFF}")); |
| |
| |
| ##### 7..11 |
| |
| my $all_undef_9 = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideCJK => undef, |
| overrideHangul => undef, |
| UCA_Version => 9, |
| ); |
| |
| # CJK Ideo. < CJK ext A/B < Others. |
| # No hangul decomposition. |
| |
| ok($all_undef_9->lt("\x{4E00}", "\x{3402}")); |
| ok($all_undef_9->lt("\x{3402}", "\x{20000}")); |
| ok($all_undef_9->lt("\x{20000}", "\x{AC00}")); |
| ok($all_undef_9->gt("\x{AC00}", "\x{1100}\x{1161}")); |
| ok($all_undef_9->gt("\x{AC00}", "\x{ABFF}")); # U+ABFF: not assigned |
| |
| ##### 12..16 |
| |
| my $ignoreHangul = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideHangul => sub {()}, |
| entry => <<'ENTRIES', |
| AE00 ; [.0100.0020.0002.AE00] # Hangul GEUL |
| ENTRIES |
| ); |
| |
| # All Hangul Syllables except U+AE00 are ignored. |
| |
| ok($ignoreHangul->eq("\x{AC00}", "")); |
| ok($ignoreHangul->lt("\x{AC00}", "\0")); |
| ok($ignoreHangul->lt("\x{AC00}", "\x{AE00}")); |
| ok($ignoreHangul->lt("\x{AC00}", "\x{1100}\x{1161}")); # Jamo are not ignored. |
| ok($ignoreHangul->lt("Pe\x{AE00}rl", "Perl")); # 'r' is unassigned. |
| |
| ##### 17..21 |
| |
| my $undefHangul = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideHangul => sub { |
| my $u = shift; |
| return $u == 0xAE00 ? 0x100 : undef; |
| } |
| ); |
| |
| # All Hangul Syllables except U+AE00 are undefined. |
| |
| ok($undefHangul->lt("\x{AE00}", "r")); |
| ok($undefHangul->gt("\x{AC00}", "r")); |
| ok($undefHangul->gt("\x{AC00}", "\x{1100}\x{1161}")); |
| ok($undefHangul->lt("Pe\x{AE00}rl", "Perl")); # 'r' is unassigned. |
| ok($undefHangul->lt("\x{AC00}", "\x{B000}")); |
| |
| ##### 22..25 |
| |
| my $undefCJK = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideCJK => sub { |
| my $u = shift; |
| return $u == 0x4E00 ? 0x100 : undef; |
| } |
| ); |
| |
| # All CJK Ideographs except U+4E00 are undefined. |
| |
| ok($undefCJK->lt("\x{4E00}", "r")); |
| ok($undefCJK->lt("\x{5000}", "r")); # still CJK < unassigned |
| ok($undefCJK->lt("Pe\x{4E00}rl", "Perl")); # 'r' is unassigned. |
| ok($undefCJK->lt("\x{5000}", "\x{6000}")); |
| |
| ##### 26..30 |
| |
| my $cpHangul = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideHangul => sub { shift } |
| ); |
| |
| ok($cpHangul->lt("\x{AC00}", "\x{AC01}")); |
| ok($cpHangul->lt("\x{AC01}", "\x{D7A3}")); |
| ok($cpHangul->lt("\x{D7A3}", "r")); # 'r' is unassigned. |
| ok($cpHangul->lt("r", "\x{D7A4}")); |
| ok($cpHangul->lt("\x{D7A3}", "\x{4E00}")); |
| |
| ##### 31..35 |
| |
| my $arrayHangul = Unicode::Collate->new( |
| table => undef, |
| normalization => undef, |
| overrideHangul => sub { |
| my $u = shift; |
| return [$u, 0x20, 0x2, $u]; |
| } |
| ); |
| |
| ok($arrayHangul->lt("\x{AC00}", "\x{AC01}")); |
| ok($arrayHangul->lt("\x{AC01}", "\x{D7A3}")); |
| ok($arrayHangul->lt("\x{D7A3}", "r")); # 'r' is unassigned. |
| ok($arrayHangul->lt("r", "\x{D7A4}")); |
| ok($arrayHangul->lt("\x{D7A3}", "\x{4E00}")); |
| |