BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
- @INC = qw(../lib);
+ @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
}
}
use Test;
-BEGIN { plan tests => 184 };
+BEGIN { plan tests => 194 };
use Unicode::Collate;
+our $IsEBCDIC = ord("A") != 0x41;
+
#########################
ok(1); # If we made it this far, we're ok.
##############
-my $A_acute = pack('U', 0x00C1);
-my $a_acute = pack('U', 0x00E1);
+# Use pack('U'), not chr(), for Perl 5.6.1.
+my $A_acute = pack('U', $IsEBCDIC ? 0x65 : 0xC1);
+my $a_acute = pack('U', $IsEBCDIC ? 0x45 : 0xE1);
my $acute = pack('U', 0x0301);
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
+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));
eval { require Unicode::Normalize };
-if (!$@) {
+if (!$@ && !$IsEBCDIC) {
my $NFD = Unicode::Collate->new(
table => undef,
entry => <<'ENTRIES',
entry => << 'ENTRIES',
0063 0068 ; [.0A3F.0020.0002.0063] % "ch" in traditional Spanish
0043 0068 ; [.0A3F.0020.0008.0043] # "Ch" in traditional Spanish
- 00DF ; [.0BA7.0020.0004.00DF][.0000.0153.0004.00DF][.0BA7.0020.001F.00DF] # sz
ENTRIES
);
# 0063 ; [.0A3D.0020.0002.0063] # LATIN SMALL LETTER C
# 0064 ; [.0A49.0020.0002.0064] # LATIN SMALL LETTER D
-# 0073 ; [.0BA7.0020.0002.0073] # LATIN SMALL LETTER S
+# Deutsch sz is included in 'keys.txt';
ok(
join(':', $trad->sort( qw/ acha aca ada acia acka / ) ),
join(':', qw/ aca acha acia acka ada / ),
);
ok($trad->eq("ocho", "oc\cAho")); # UCA v9
-ok($trad->eq("ocho", "oc\000\cA\000\x7Fho")); # UCA v9
+ok($trad->eq("ocho", "oc\0\cA\0\cBho")); # UCA v9
my $hiragana = "\x{3042}\x{3044}";
my $katakana = "\x{30A2}\x{30A4}";
##############
-$Collator->change(level => 2);
-
-my $str;
-
-my $orig = "This is a Perl book.";
-my $sub = "PERL";
-my $rep = "camel";
-my $ret = "This is a camel book.";
-
-$str = $orig;
-if (my($pos,$len) = $Collator->index($str, $sub)) {
- substr($str, $pos, $len, $rep);
-}
-
-ok($str, $ret);
-
-$Collator->change(%old_level);
-
-$str = $orig;
-if (my($pos,$len) = $Collator->index($str, $sub)) {
- substr($str, $pos, $len, $rep);
-}
-
-ok($str, $orig);
-
-##############
-
-my $match;
-
-$Collator->change(level => 1);
-
-$str = "Pe\x{300}rl";
-$sub = "pe";
-$match = undef;
-if (my($pos, $len) = $Collator->index($str, $sub)) {
- $match = substr($str, $pos, $len);
-}
-ok($match, "Pe\x{300}");
-
-$str = "P\x{300}e\x{300}\x{301}\x{303}rl";
-$sub = "pE";
-$match = undef;
-if (my($pos, $len) = $Collator->index($str, $sub)) {
- $match = substr($str, $pos, $len);
-}
-ok($match, "P\x{300}e\x{300}\x{301}\x{303}");
-
-$Collator->change(%old_level);
-
-##############
-
-%old_level = $trad->change(level => 1);
-
-$str = "Ich mu\x{00DF} studieren.";
-$sub = "m\x{00FC}ss";
-$match = undef;
-if (my($pos, $len) = $trad->index($str, $sub)) {
- $match = substr($str, $pos, $len);
-}
-ok($match, "mu\x{00DF}");
-
-$trad->change(%old_level);
-
-$str = "Ich mu\x{00DF} studieren.";
-$sub = "m\x{00FC}ss";
-$match = undef;
-
-if (my($pos, $len) = $trad->index($str, $sub)) {
- $match = substr($str, $pos, $len);
-}
-ok($match, undef);
-
-$match = undef;
-if (my($pos,$len) = $Collator->index("", "")) {
- $match = substr("", $pos, $len);
-}
-ok($match, "");
-
-$match = undef;
-if (my($pos,$len) = $Collator->index("", "abc")) {
- $match = substr("", $pos, $len);
-}
-ok($match, undef);
-
-##############
-
# Table is undefined, then no entry is defined.
my $undef_table = Unicode::Collate->new(
ok($Collator->gt("\x{0E41}A", "\x{0E40}B"));
ok($Collator->gt("A\x{0E41}A", "A\x{0E40}B"));
-$Collator->change(rearrange => [ 0x61 ]); # 'a'
+$Collator->change(rearrange => [ 0x61 ]);
+ # U+0061, 'a': This is a Unicode value, never a native value.
ok($Collator->gt("ab", "AB")); # as 'ba' > 'AB'
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.
##############
-# Shifted; ignorable after variable
+# ignorable after variable
+# Shifted;
ok($Collator->eq("?\x{300}!\x{301}\x{315}", "?!"));
-ok($Collator->eq("?\x{300}A\x{300}", "?A\x{300}"));
+ok($Collator->eq("?\x{300}A\x{301}", "?$A_acute"));
ok($Collator->eq("?\x{300}", "?"));
+ok($Collator->eq("?\x{344}", "?")); # U+0344 has two CEs.
-$Collator->change(alternate => 'Non-ignorable');
+$Collator->change(level => 3);
+ok($Collator->eq("\cA", "?"));
+
+$Collator->change(alternate => 'blanked', level => 4);
+ok($Collator->eq("?\x{300}!\x{301}\x{315}", "?!"));
+ok($Collator->eq("?\x{300}A\x{301}", "?$A_acute"));
+ok($Collator->eq("?\x{300}", "?"));
+ok($Collator->eq("?\x{344}", "?")); # U+0344 has two CEs.
+
+$Collator->change(level => 3);
+ok($Collator->eq("\cA", "?"));
+$Collator->change(alternate => 'Non-ignorable', level => 4);
+
+ok($Collator->lt("?\x{300}", "?!"));
+ok($Collator->gt("?\x{300}A$acute", "?$A_acute"));
ok($Collator->gt("?\x{300}", "?"));
+ok($Collator->gt("?\x{344}", "?"));
-$Collator->change(alternate => 'Shifted');
+$Collator->change(level => 3);
+ok($Collator->lt("\cA", "?"));
+
+$Collator->change(alternate => 'Shifted', level => 4);
+
+##############
+
+# According to Conformance Test,
+# a L3-ignorable is treated as a completely ignorable.
+
+my $L3ignorable = Unicode::Collate->new(
+ alternate => 'Non-ignorable',
+ table => undef,
+ normalization => undef,
+ entry => <<'ENTRIES',
+0000 ; [.0000.0000.0000.0000] # [0000] NULL (in 6429)
+0001 ; [.0000.0000.0000.0000] # [0001] START OF HEADING (in 6429)
+0591 ; [.0000.0000.0000.0591] # HEBREW ACCENT ETNAHTA
+1D165 ; [.0000.0000.0000.1D165] # MUSICAL SYMBOL COMBINING STEM
+0021 ; [*024B.0020.0002.0021] # EXCLAMATION MARK
+09BE ; [.114E.0020.0002.09BE] # BENGALI VOWEL SIGN AA
+09C7 ; [.1157.0020.0002.09C7] # BENGALI VOWEL SIGN E
+09CB ; [.1159.0020.0002.09CB] # BENGALI VOWEL SIGN O
+09C7 09BE ; [.1159.0020.0002.09CB] # BENGALI VOWEL SIGN O
+ENTRIES
+);
+
+ok($L3ignorable->lt("\cA", "!"));
+ok($L3ignorable->lt("\x{591}", "!"));
+ok($L3ignorable->eq("\cA", "\x{591}"));
+ok($L3ignorable->eq("\x{09C7}\x{09BE}A", "\x{09C7}\cA\x{09BE}A"));
+ok($L3ignorable->eq("\x{09C7}\x{09BE}A", "\x{09C7}\x{0591}\x{09BE}A"));
+ok($L3ignorable->eq("\x{09C7}\x{09BE}A", "\x{09C7}\x{1D165}\x{09BE}A"));
+ok($L3ignorable->eq("\x{09C7}\x{09BE}A", "\x{09CB}A"));
projects / p5sagit/p5-mst-13.2.git / blobdiff