diff options
Diffstat (limited to 'ext/Unicode-Collate/t/test.t')
| -rw-r--r-- | ext/Unicode-Collate/t/test.t | 399 |
1 files changed, 399 insertions, 0 deletions
diff --git a/ext/Unicode-Collate/t/test.t b/ext/Unicode-Collate/t/test.t new file mode 100644 index 0000000000..698802e9be --- /dev/null +++ b/ext/Unicode-Collate/t/test.t @@ -0,0 +1,399 @@ + +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 Test; +BEGIN { plan tests => 113 }; + +use strict; +use warnings; +use Unicode::Collate; + +ok(1); + +sub _pack_U { Unicode::Collate::pack_U(@_) } +sub _unpack_U { Unicode::Collate::unpack_U(@_) } + +my $A_acute = _pack_U(0xC1); +my $a_acute = _pack_U(0xE1); +my $acute = _pack_U(0x0301); + +my $hiragana = "\x{3042}\x{3044}"; +my $katakana = "\x{30A2}\x{30A4}"; + +##### 2..7 + +my $Collator = Unicode::Collate->new( + table => 'keys.txt', + normalization => undef, +); + +ok(ref $Collator, "Unicode::Collate"); + +ok($Collator->cmp("", ""), 0); +ok($Collator->eq("", "")); +ok($Collator->cmp("", "perl"), -1); + +ok( + join(':', $Collator->sort( qw/ acha aca ada acia acka / ) ), + join(':', qw/ aca acha acia acka ada / ), +); + +ok( + join(':', $Collator->sort( qw/ ACHA ACA ADA ACIA ACKA / ) ), + join(':', qw/ ACA ACHA ACIA ACKA ADA / ), +); + +##### 8..18 + +ok($Collator->cmp("A$acute", $A_acute), 0); # @version 3.1.1 (prev: -1) +ok($Collator->cmp($a_acute, $A_acute), -1); +ok($Collator->eq("A\cA$acute", $A_acute)); # UCA v9. \cA is invariant. + +my %old_level = $Collator->change(level => 1); +ok($Collator->eq("A$acute", $A_acute)); +ok($Collator->eq("A", $A_acute)); + +ok($Collator->change(level => 2)->eq($a_acute, $A_acute)); +ok($Collator->lt("A", $A_acute)); + +ok($Collator->change(%old_level)->lt("A", $A_acute)); +ok($Collator->lt("A", $A_acute)); +ok($Collator->lt("A", $a_acute)); +ok($Collator->lt($a_acute, $A_acute)); + +##### 19..25 + +$Collator->change(level => 2); + +ok($Collator->{level}, 2); + +ok( $Collator->cmp("ABC","abc"), 0); +ok( $Collator->eq("ABC","abc") ); +ok( $Collator->le("ABC","abc") ); +ok( $Collator->cmp($hiragana, $katakana), 0); +ok( $Collator->eq($hiragana, $katakana) ); +ok( $Collator->ge($hiragana, $katakana) ); + +##### 26..31 + +# hangul +ok( $Collator->eq("a\x{AC00}b", "a\x{1100}\x{1161}b") ); +ok( $Collator->eq("a\x{AE00}b", "a\x{1100}\x{1173}\x{11AF}b") ); +ok( $Collator->gt("a\x{AE00}b", "a\x{1100}\x{1173}b\x{11AF}") ); +ok( $Collator->lt("a\x{AC00}b", "a\x{AE00}b") ); +ok( $Collator->gt("a\x{D7A3}b", "a\x{C544}b") ); +ok( $Collator->lt("a\x{C544}b", "a\x{30A2}b") ); # hangul < hiragana + +##### 32..40 + +$Collator->change(%old_level, katakana_before_hiragana => 1); + +ok($Collator->{level}, 4); + +ok( $Collator->cmp("abc", "ABC"), -1); +ok( $Collator->ne("abc", "ABC") ); +ok( $Collator->lt("abc", "ABC") ); +ok( $Collator->le("abc", "ABC") ); +ok( $Collator->cmp($hiragana, $katakana), 1); +ok( $Collator->ne($hiragana, $katakana) ); +ok( $Collator->gt($hiragana, $katakana) ); +ok( $Collator->ge($hiragana, $katakana) ); + +##### 41..46 + +$Collator->change(upper_before_lower => 1); + +ok( $Collator->cmp("abc", "ABC"), 1); +ok( $Collator->ge("abc", "ABC"), 1); +ok( $Collator->gt("abc", "ABC"), 1); +ok( $Collator->cmp($hiragana, $katakana), 1); +ok( $Collator->ge($hiragana, $katakana), 1); +ok( $Collator->gt($hiragana, $katakana), 1); + +##### 47..48 + +$Collator->change(katakana_before_hiragana => 0); + +ok( $Collator->cmp("abc", "ABC"), 1); +ok( $Collator->cmp($hiragana, $katakana), -1); + +##### 49..52 + +$Collator->change(upper_before_lower => 0); + +ok( $Collator->cmp("abc", "ABC"), -1); +ok( $Collator->le("abc", "ABC") ); +ok( $Collator->cmp($hiragana, $katakana), -1); +ok( $Collator->lt($hiragana, $katakana) ); + +##### 53..54 + +my $ignoreAE = Unicode::Collate->new( + table => 'keys.txt', + normalization => undef, + ignoreChar => qr/^[aAeE]$/, +); + +ok($ignoreAE->eq("element","lament")); +ok($ignoreAE->eq("Perl","ePrl")); + +##### 55 + +my $onlyABC = Unicode::Collate->new( + table => undef, + normalization => undef, + entry => << 'ENTRIES', +0061 ; [.0101.0020.0002.0061] # LATIN SMALL LETTER A +0041 ; [.0101.0020.0008.0041] # LATIN CAPITAL LETTER A +0062 ; [.0102.0020.0002.0062] # LATIN SMALL LETTER B +0042 ; [.0102.0020.0008.0042] # LATIN CAPITAL LETTER B +0063 ; [.0103.0020.0002.0063] # LATIN SMALL LETTER C +0043 ; [.0103.0020.0008.0043] # LATIN CAPITAL LETTER C +ENTRIES +); + +ok( + join(':', $onlyABC->sort( qw/ ABA BAC cc A Ab cAc aB / ) ), + join(':', qw/ A aB Ab ABA BAC cAc cc / ), +); + +##### 56..59 + +my $undefAE = Unicode::Collate->new( + table => 'keys.txt', + normalization => undef, + undefChar => qr/^[aAeE]$/, +); + +ok($undefAE ->gt("edge","fog")); +ok($Collator->lt("edge","fog")); +ok($undefAE ->gt("lake","like")); +ok($Collator->lt("lake","like")); + +##### 60..69 + +# Table is undefined, then no entry is defined. + +my $undef_table = Unicode::Collate->new( + table => undef, + normalization => undef, + level => 1, +); + +# in the Unicode code point order +ok($undef_table->lt('', 'A')); +ok($undef_table->lt('ABC', 'B')); + +# Hangul should be decomposed (even w/o Unicode::Normalize). +ok($undef_table->lt("Perl", "\x{AC00}")); +ok($undef_table->eq("\x{AC00}", "\x{1100}\x{1161}")); +ok($undef_table->eq("\x{AE00}", "\x{1100}\x{1173}\x{11AF}")); +ok($undef_table->lt("\x{AE00}", "\x{3042}")); + # U+AC00: Hangul GA + # U+AE00: Hangul GEUL + # U+3042: Hiragana A + +# Weight for CJK Ideographs is defined, though. +ok($undef_table->lt("", "\x{4E00}")); +ok($undef_table->lt("\x{4E8C}","ABC")); +ok($undef_table->lt("\x{4E00}","\x{3042}")); +ok($undef_table->lt("\x{4E00}","\x{4E8C}")); + # U+4E00: Ideograph "ONE" + # U+4E8C: Ideograph "TWO" + + +##### 70..74 + +my $few_entries = Unicode::Collate->new( + entry => <<'ENTRIES', +0050 ; [.0101.0020.0002.0050] # P +0045 ; [.0102.0020.0002.0045] # E +0052 ; [.0103.0020.0002.0052] # R +004C ; [.0104.0020.0002.004C] # L +1100 ; [.0105.0020.0002.1100] # Hangul Jamo initial G +1175 ; [.0106.0020.0002.1175] # Hangul Jamo middle I +5B57 ; [.0107.0020.0002.5B57] # CJK Ideograph "Letter" +ENTRIES + table => undef, + normalization => undef, +); + +# defined before undefined + +my $sortABC = join '', + $few_entries->sort(split //, "ABCDEFGHIJKLMNOPQRSTUVWXYZ "); + +ok($sortABC eq "PERL ABCDFGHIJKMNOQSTUVWXYZ"); + +ok($few_entries->lt('E', 'D')); +ok($few_entries->lt("\x{5B57}", "\x{4E00}")); +ok($few_entries->lt("\x{AE30}", "\x{AC00}")); + +# Hangul must be decomposed. + +ok($few_entries->eq("\x{AC00}", "\x{1100}\x{1161}")); + +##### 75..79 + +my $dropArticles = Unicode::Collate->new( + table => "keys.txt", + normalization => undef, + preprocess => sub { + my $string = shift; + $string =~ s/\b(?:an?|the)\s+//ig; + $string; + }, +); + +ok($dropArticles->eq("camel", "a camel")); +ok($dropArticles->eq("Perl", "The Perl")); +ok($dropArticles->lt("the pen", "a pencil")); +ok($Collator->lt("Perl", "The Perl")); +ok($Collator->gt("the pen", "a pencil")); + +##### 80..81 + +my $backLevel1 = Unicode::Collate->new( + table => undef, + normalization => undef, + backwards => [ 1 ], +); + +# all strings are reversed at level 1. + +ok($backLevel1->gt("AB", "BA")); +ok($backLevel1->gt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); + +##### 82..89 + +my $backLevel2 = Unicode::Collate->new( + table => "keys.txt", + normalization => undef, + undefName => qr/HANGUL|HIRAGANA|KATAKANA|BOPOMOFO/, + backwards => 2, +); + +ok($backLevel2->gt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); +ok($backLevel2->gt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); +ok($Collator ->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); +ok($Collator ->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); + +# HIRAGANA and KATAKANA are made undefined via undefName. +# So they are after CJK Unified Ideographs. + +ok($backLevel2->lt("\x{4E00}", $hiragana)); +ok($backLevel2->lt("\x{4E03}", $katakana)); +ok($Collator ->gt("\x{4E00}", $hiragana)); +ok($Collator ->gt("\x{4E03}", $katakana)); + + +##### 90..96 + +my $O_str = Unicode::Collate->new( + table => "keys.txt", + normalization => undef, + entry => <<'ENTRIES', +0008 ; [*0008.0000.0000.0000] # BACKSPACE (need to be non-ignorable) +004F 0337 ; [.0B53.0020.0008.004F] # capital O WITH SHORT SOLIDUS OVERLAY +006F 0008 002F ; [.0B53.0020.0002.006F] # LATIN SMALL LETTER O WITH STROKE +004F 0008 002F ; [.0B53.0020.0008.004F] # LATIN CAPITAL LETTER O WITH STROKE +006F 0337 ; [.0B53.0020.0002.004F] # small O WITH SHORT SOLIDUS OVERLAY +200B ; [.2000.0000.0000.0000] # ZERO WIDTH SPACE (may be non-sense but ...) +#00F8 ; [.0B53.0020.0002.00F8] # LATIN SMALL LETTER O WITH STROKE +#00D8 ; [.0B53.0020.0008.00D8] # LATIN CAPITAL LETTER O WITH STROKE +ENTRIES +); + +my $o_BS_slash = _pack_U(0x006F, 0x0008, 0x002F); +my $O_BS_slash = _pack_U(0x004F, 0x0008, 0x002F); +my $o_sol = _pack_U(0x006F, 0x0337); +my $O_sol = _pack_U(0x004F, 0x0337); +my $o_stroke = _pack_U(0x00F8); +my $O_stroke = _pack_U(0x00D8); + +ok($O_str->eq($o_stroke, $o_BS_slash)); +ok($O_str->eq($O_stroke, $O_BS_slash)); + +ok($O_str->eq($o_stroke, $o_sol)); +ok($O_str->eq($O_stroke, $O_sol)); + +ok($Collator->eq("\x{200B}", "\0")); +ok($O_str ->gt("\x{200B}", "\0")); +ok($O_str ->gt("\x{200B}", "A")); + +##### 97..107 + +my %origVer = $Collator->change(UCA_Version => 8); + +$Collator->change(level => 3); + +ok($Collator->gt("!\x{300}", "")); +ok($Collator->gt("!\x{300}", "!")); +ok($Collator->eq("!\x{300}", "\x{300}")); + +$Collator->change(level => 2); + +ok($Collator->eq("!\x{300}", "\x{300}")); + +$Collator->change(level => 4); + +ok($Collator->gt("!\x{300}", "!")); +ok($Collator->lt("!\x{300}", "\x{300}")); + +$Collator->change(%origVer, level => 3); + +ok($Collator->eq("!\x{300}", "")); +ok($Collator->eq("!\x{300}", "!")); +ok($Collator->lt("!\x{300}", "\x{300}")); + +$Collator->change(level => 4); + +ok($Collator->gt("!\x{300}", "")); +ok($Collator->eq("!\x{300}", "!")); + +##### 108..113 + +$_ = 'Foo'; + +my $c = Unicode::Collate->new( + table => 'keys.txt', + normalization => undef, + upper_before_lower => 1, +); + +ok($_, 'Foo'); # fixed at v. 0.52; no longer clobber $_ + +my($temp, @temp); # Not the result but the side effect matters. + +$_ = 'Foo'; +$temp = $c->getSortKey("abc"); +ok($_, 'Foo'); + +$_ = 'Foo'; +$temp = $c->viewSortKey("abc"); +ok($_, 'Foo'); + +$_ = 'Foo'; +@temp = $c->sort("abc", "xyz", "def"); +ok($_, 'Foo'); + +$_ = 'Foo'; +@temp = $c->index("perl5", "RL"); +ok($_, 'Foo'); + +$_ = 'Foo'; +@temp = $c->index("perl5", "LR"); +ok($_, 'Foo'); + +##### + |