cpan/Unicode-Collate/t/default.t Unicode::Collate
cpan/Unicode-Collate/t/hangtype.t Unicode::Collate
cpan/Unicode-Collate/t/hangul.t Unicode::Collate
+cpan/Unicode-Collate/t/ident.t
cpan/Unicode-Collate/t/iglevel2.t Unicode::Collate
cpan/Unicode-Collate/t/ignor.t Unicode::Collate
cpan/Unicode-Collate/t/illegalp.t Unicode::Collate
'Unicode::Collate' => {
'MAINTAINER' => 'sadahiro',
- 'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-0.91.tar.gz',
+ 'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-0.92.tar.gz',
'FILES' => q[cpan/Unicode-Collate],
'EXCLUDED' => [
qr{N$},
Revision history for Perl module Unicode::Collate.
+0.92 Wed Nov 14 20:58:19 2012
+ - fix: index() etc. with preprocess/normalization should be always croaked.
+ - doc: referred to the latest UTS #10 and updated its section numbers.
+ - supported the identical level (see 'identical' in POD).
+ - Now UCA_Version 26 (for Unicode 6.2.0) is supported.
+ - added ident.t in t.
+ - modified tests: cjkrange.t, compatui.t, hangtype.t, index.t,
+ overcjk0.t, overcjk1.t, test.t, view.t in t.
+
+ * But the default UCA_Version is still 24.
+ (In the next release, UCA_Version 26 will be the default.)
+
0.91 Sun Nov 4 17:00:20 2012
- XSUB: use PERL_NO_GET_CONTEXT (see perlguts)
(see [rt.cpan.org #80313])
0.29 Mon Oct 13 12:18:23 2003
- now UCA Version 11 (but no functionality is different from Version 9).
- - supported hangul_terminator.
+ - supported 'hangul_terminator'.
- fix: Base_Unicode_Version falsely returns Perl's Unicode version.
C4 in UTS #10 requires UTS's Unicode version.
- For variable weighting, 'variable' is recommended
no warnings 'utf8';
-our $VERSION = '0.91';
+our $VERSION = '0.92';
our $PACKAGE = __PACKAGE__;
### begin XS only ###
use constant Shift4Wt => 0xFFFF;
# A boolean for Variable and 16-bit weights at 4 levels of Collation Element
-# PROBLEM: The Default Unicode Collation Element Table
-# has weights over 0xFFFF at the 4th level.
-# The tie-breaking in the variable weights
-# other than "shift" (as well as "shift-trimmed") is unreliable.
use constant VCE_TEMPLATE => 'Cn4';
# A sort key: 16-bit weights
-# See also the PROBLEM on VCE_TEMPLATE above.
use constant KEY_TEMPLATE => 'n*';
+# The tie-breaking: 32-bit weights
+use constant TIE_TEMPLATE => 'N*';
+
# Level separator in a sort key:
# i.e. pack(KEY_TEMPLATE, 0)
use constant LEVEL_SEP => "\0\0";
alternate backwards level normalization rearrange
katakana_before_hiragana upper_before_lower ignore_level2
overrideHangul overrideCJK preprocess UCA_Version
- hangul_terminator variable
+ hangul_terminator variable identical
/;
our @ChangeNG = qw/
my $self = shift;
my %hash = @_;
my %old;
- if (exists $hash{variable} && exists $hash{alternate}) {
- delete $hash{alternate};
- }
- elsif (!exists $hash{variable} && exists $hash{alternate}) {
- $hash{variable} = $hash{alternate};
+ if (exists $hash{alternate}) {
+ if (exists $hash{variable}) {
+ delete $hash{alternate};
+ } else {
+ $hash{variable} = $hash{alternate};
+ }
}
foreach my $k (keys %hash) {
if (exists $ChangeOK{$k}) {
$old{$k} = $self->{$k};
$self->{$k} = $hash{$k};
- }
- elsif (exists $ChangeNG{$k}) {
+ } elsif (exists $ChangeNG{$k}) {
croak "change of $k via change() is not allowed!";
}
# else => ignored
20 => \&_derivCE_20,
22 => \&_derivCE_22,
24 => \&_derivCE_24,
+ 26 => \&_derivCE_24, # 26 == 24
);
sub checkCollator {
if (! defined $self->{backwards}) {
$self->{backwardsFlag} = 0;
- }
- elsif (! ref $self->{backwards}) {
+ } elsif (! ref $self->{backwards}) {
_checkLevel($self->{backwards}, "backwards");
$self->{backwardsFlag} = 1 << $self->{backwards};
- }
- else {
+ } else {
my %level;
$self->{backwardsFlag} = 0;
for my $b (@{ $self->{backwards} }) {
sub viewSortKey
{
my $self = shift;
- $self->visualizeSortKey($self->getSortKey(@_));
+ my $str = shift;
+ $self->visualizeSortKey($self->getSortKey($str));
}
+sub process
+{
+ my $self = shift;
+ my $str = shift;
+ my $prep = $self->{preprocess};
+ my $norm = $self->{normCode};
+
+ $str = &$prep($str) if ref $prep;
+ $str = &$norm($str) if ref $norm;
+ return $str;
+}
+
##
## arrayref of JCPS = splitEnt(string to be collated)
-## arrayref of arrayref[JCPS, ini_pos, fin_pos] = splitEnt(string, true)
+## arrayref of arrayref[JCPS, ini_pos, fin_pos] = splitEnt(string, TRUE)
##
sub splitEnt
{
my $self = shift;
- my $wLen = $_[1];
+ my $str = shift;
+ my $wLen = shift; # with Length
- my $code = $self->{preprocess};
- my $norm = $self->{normCode};
my $map = $self->{mapping};
my $max = $self->{maxlength};
my $reH = $self->{rearrangeHash};
my $ver9 = $vers >= 9 && $vers <= 11;
my $uXS = $self->{__useXS}; ### XS only
- my ($str, @buf);
-
- if ($wLen) {
- $code and croak "Preprocess breaks character positions. "
- . "Don't use with index(), match(), etc.";
- $norm and croak "Normalization breaks character positions. "
- . "Don't use with index(), match(), etc.";
- $str = $_[0];
- }
- else {
- $str = $_[0];
- $str = &$code($str) if ref $code;
- $str = &$norm($str) if ref $norm;
- }
+ my @buf;
# get array of Unicode code point of string.
my @src = unpack_U($str);
sub getSortKey
{
my $self = shift;
- my $rEnt = $self->splitEnt(shift); # get an arrayref of JCPS
+ my $orig = shift;
+ my $str = $self->process($orig);
+ my $rEnt = $self->splitEnt($str); # get an arrayref of JCPS
my $vers = $self->{UCA_Version};
my $term = $self->{hangul_terminator};
+ my $lev = $self->{level};
+ my $iden = $self->{identical};
my @buf; # weight arrays
if ($term) {
}
}
- return $self->mk_SortKey(\@buf); ### XS only
+ my $rkey = $self->mk_SortKey(\@buf); ### XS only
+
+ if ($iden || $vers >= 26 && $lev == MaxLevel) {
+ $rkey .= LEVEL_SEP;
+ $rkey .= pack(TIE_TEMPLATE, unpack_U($str)) if $iden;
+ }
+ return $rkey;
}
sub index
{
my $self = shift;
+ $self->{preprocess} and
+ croak "Don't use Preprocess with index(), match(), etc.";
+ $self->{normCode} and
+ croak "Don't use Normalization with index(), match(), etc.";
+
my $str = shift;
my $len = length($str);
- my $subE = $self->splitEnt(shift);
+ my $sub = shift;
+ my $subE = $self->splitEnt($sub);
my $pos = @_ ? shift : 0;
$pos = 0 if $pos < 0;
my $glob = shift;
backwards => $levelNumber, # or \@levelNumbers
entry => $element,
hangul_terminator => $term_primary_weight,
+ identical => $bool,
ignoreName => qr/$ignoreName/,
ignoreChar => qr/$ignoreChar/,
ignore_level2 => $bool,
20 5.2.0 5.2.0 (5.2.0)
22 6.0.0 6.0.0 (6.0.0)
24 6.1.0 6.1.0 (6.1.0)
+ 26 6.2.0 6.2.0 (6.2.0)
* Noncharacters (e.g. U+FFFF) are not ignored, and can be overridden
since C<UCA_Version> 22.
=item backwards
--- see 3.1.2 French Accents, UTS #10.
+-- see 3.4 Backward Accents, UTS #10.
backwards => $levelNumber or \@levelNumbers
=item entry
--- see 3.1 Linguistic Features; 3.2.1 File Format, UTS #10.
+-- see 5 Tailoring; 3.6.1 File Format, UTS #10.
If the same character (or a sequence of characters) exists
in the collation element table through C<table>,
These characters may need terminator included in a collation element
table beforehand.
+=item identical
+
+-- see A.3 Deterministic Comparison, UTS #10.
+
+By default, strings whose weights are equal should be equal,
+even though their code points are not equal.
+
+If the parameter is made true, a final, tie-breaking level is used.
+If no difference of weights is found after the comparison through all
+the level (independent of the value of C<level>), the comparison with
+code points will be performed. For the tie-breaking comparision,
+the sort key has code points of the original string appended.
+
+If C<preprocess> and/or C<normalization> is applied, the code points
+of the string after them (in NFD by default) are used.
+
=item ignoreChar
=item ignoreName
--- see 3.2.2 Variable Weighting, UTS #10.
+-- see 3.6.2 Variable Weighting, UTS #10.
Makes the entry in the table completely ignorable;
i.e. as if the weights were zero at all level.
=item katakana_before_hiragana
--- see 7.3.1 Tertiary Weight Table, UTS #10.
+-- see 7.2 Tertiary Weight Table, UTS #10.
By default, hiragana is before katakana.
If the parameter is made true, this is reversed.
If omitted, the maximum is the 4th.
+B<NOTE:> The DUCET includes weights over 0xFFFF at the 4th level.
+But this module only uses weights within 0xFFFF.
+When C<variable> is 'blanked' or 'non-ignorable' (other than 'shifted'
+and 'shift-trimmed'), the level 4 may be unreliable.
+
+See also C<identical>.
+
=item normalization
-- see 4.1 Normalize, UTS #10.
U+4E00..U+9FBB if UCA_Version is 14 or 16.
U+4E00..U+9FC3 if UCA_Version is 18.
U+4E00..U+9FCB if UCA_Version is 20 or 22.
- U+4E00..U+9FCC if UCA_Version is 24.
+ U+4E00..U+9FCC if UCA_Version is 24 or 26.
In the CJK Unified Ideographs Extension blocks:
Ext.A (U+3400..U+4DB5) and Ext.B (U+20000..U+2A6D6) in any UCA_Version.
=item preprocess
--- see 5.1 Preprocessing, UTS #10.
+-- see 5.4 Preprocessing, UTS #10.
If specified, the coderef is used to preprocess each string
before the formation of sort keys.
=item rearrange
--- see 3.1.3 Rearrangement, UTS #10.
+-- see 3.5 Rearrangement, UTS #10.
Characters that are not coded in logical order and to be rearranged.
If C<UCA_Version> is equal to or lesser than 11, default is:
=item table
--- see 3.2 Default Unicode Collation Element Table, UTS #10.
+-- see 3.6 Default Unicode Collation Element Table, UTS #10.
You can use another collation element table if desired.
=item variable
--- see 3.2.2 Variable Weighting, UTS #10.
+-- see 3.6.2 Variable Weighting, UTS #10.
This key allows for variable weighting of variable collation elements,
which are marked with an ASTERISK in the table
for F<CollationTest_NON_IGNORABLE.txt>, a collator via
C<Unicode::Collate-E<gt>new(variable =E<gt> "non-ignorable", level =E<gt> 3)>.
+If C<UCA_Version> is 26 or later, the C<identical> level is preferred;
+C<Unicode::Collate-E<gt>new(identical =E<gt> 1)> and
+C<Unicode::Collate-E<gt>new(identical =E<gt> 1,>
+C<variable =E<gt> "non-ignorable", level =E<gt> 3)> should be used.
+
B<Unicode::Normalize is required to try The Conformance Test.>
=back
else if (*a == 's') { /* shifted or shift-trimmed */
totwt = d[1] + d[2] + d[3] + d[4] + d[5] + d[6];
if (alen == 7 && totwt != 0) { /* shifted */
- d[7] = (U8)(Shift4Wt >> 8);
- d[8] = (U8)(Shift4Wt & 0xFF);
- }
- else { /* shift-trimmed */
+ if (d[1] == 0 && d[2] == 1) { /* XXX: CollationAuxiliary-6.2.0 */
+ d[7] = d[1]; /* wt level 1 to 4 */
+ d[8] = d[2];
+ } else {
+ d[7] = (U8)(Shift4Wt >> 8);
+ d[8] = (U8)(Shift4Wt & 0xFF);
+ }
+ } else { /* shift-trimmed */
d[7] = d[8] = '\0';
}
}
U8 *s, *e, *d;
STRLEN klen, dlen;
UV uv;
- IV uca_vers;
+ IV uca_vers, sep = 0;
static const char *upperhex = "0123456789ABCDEF";
CODE:
if (SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)
s = (U8*)SvPV(key, klen);
/* slightly *longer* than the need, but I'm afraid of miscounting;
- exactly: (klen / 2) * 5 + MaxLevel * 2 - 1 (excluding '\0')
- = (klen / 2) * 5 - 1 # FFFF (16bit) and ' ' between 16bit units
- + (MaxLevel - 1) * 2 # ' ' and '|' for level boundaries
- + 2 # '[' and ']'
+ = (klen / 2) * 5 - 1
+ # FFFF and ' ' for each 16bit units but ' ' is less by 1;
+ # ' ' and '|' for level boundaries including the identical level
+ + 2 # '[' and ']'
+ + 1 # '\0'
+ (a) if klen is odd (not expected), maybe more 5 bytes.
+ (b) there is not always the identical level.
*/
dlen = (klen / 2) * 5 + MaxLevel * 2 + 2;
dst = newSV(dlen);
*d++ = '[';
for (e = s + klen; s < e; s += 2) {
uv = (U16)(*s << 8 | s[1]);
- if (uv) {
+ if (uv || sep >= MaxLevel) {
if ((d[-1] != '[') && ((9 <= uca_vers) || (d[-1] != '|')))
*d++ = ' ';
*d++ = upperhex[ (s[0] >> 4) & 0xF ];
*d++ = upperhex[ s[0] & 0xF ];
*d++ = upperhex[ (s[1] >> 4) & 0xF ];
*d++ = upperhex[ s[1] & 0xF ];
- }
- else {
+ } else {
if ((9 <= uca_vers) && (d[-1] != '['))
*d++ = ' ';
*d++ = '|';
+ ++sep;
}
}
*d++ = ']';
-Unicode/Collate version 0.91
+Unicode/Collate version 0.92
===============================
NAME
use strict;
use warnings;
-BEGIN { $| = 1; print "1..379\n"; } # 1 + 42 x @Versions
+BEGIN { $| = 1; print "1..421\n"; } # 1 + 42 x @Versions
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
# 2A700..2B734 are CJK UI Ext.C since UCA_Version 20 (Unicode 5.2).
# 2B740..2B81D are CJK UI Ext.D since UCA_Version 22 (Unicode 6.0).
-my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24);
+my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24, 26);
for my $v (@Versions) {
$coll->change(UCA_Version => $v);
use strict;
use warnings;
-BEGIN { $| = 1; print "1..631\n"; } # 1 + 70 x @Versions
+BEGIN { $| = 1; print "1..701\n"; } # 1 + 70 x @Versions
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
#########################
-my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24);
+my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24, 26);
# 12 compatibility ideographs are treated as unified ideographs:
# FA0E, FA0F, FA11, FA13, FA14, FA1F, FA21, FA23, FA24, FA27, FA28, FA29.
use strict;
use warnings;
-BEGIN { $| = 1; print "1..451\n"; } # 1 + 50 x @Versions
+BEGIN { $| = 1; print "1..501\n"; } # 1 + 50 x @Versions
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
#########################
-my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24);
+my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24, 26);
for my $v (@Versions) {
ok(Unicode::Collate::getHST(0x0000, $v), '');
--- /dev/null
+
+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..45\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);
+
+#########################
+
+my $Collator = Unicode::Collate->new(
+ table => 'keys.txt',
+ normalization => undef,
+);
+
+# [001F] UNIT SEPARATOR
+{
+ ok($Collator->eq("\0", "\x1F"));
+ ok($Collator->eq("\x1F", "\x{200B}"));
+ ok($Collator->eq("\0", "\x{200B}"));
+ ok($Collator->eq("\x{313}", "\x{343}"));
+ ok($Collator->eq("\x{2000}", "\x{2001}"));
+ ok($Collator->eq("\x{200B}", "\x{200C}"));
+ ok($Collator->eq("\x{304C}", "\x{304B}\x{3099}"));
+
+ $Collator->change(identical => 1);
+
+ ok($Collator->lt("\0", "\x1F"));
+ ok($Collator->lt("\x1F", "\x{200B}"));
+ ok($Collator->lt("\0", "\x{200B}"));
+ ok($Collator->lt("\x{313}", "\x{343}"));
+ ok($Collator->lt("\x{2000}", "\x{2001}"));
+ ok($Collator->lt("\x{200B}", "\x{200C}"));
+ ok($Collator->gt("\x{304C}", "\x{304B}\x{3099}"));
+
+ $Collator->change(identical => 0);
+
+ ok($Collator->eq("\0", "\x1F"));
+ ok($Collator->eq("\x1F", "\x{200B}"));
+ ok($Collator->eq("\0", "\x{200B}"));
+ ok($Collator->eq("\x{313}", "\x{343}"));
+ ok($Collator->eq("\x{2000}", "\x{2001}"));
+ ok($Collator->eq("\x{200B}", "\x{200C}"));
+ ok($Collator->eq("\x{304C}", "\x{304B}\x{3099}"));
+}
+
+#### 22
+
+eval { require Unicode::Normalize };
+if (!$@) {
+ $Collator->change(normalization => "NFD");
+
+ $Collator->change(identical => 1);
+
+ ok($Collator->lt("\0", "\x{200B}"));
+ ok($Collator->eq("\x{313}", "\x{343}"));
+ ok($Collator->lt("\x{2000}", "\x{2001}"));
+ ok($Collator->lt("\x{200B}", "\x{200C}"));
+ ok($Collator->eq("\x{304C}", "\x{304B}\x{3099}"));
+
+ $Collator->change(identical => 0);
+
+ ok($Collator->eq("\0", "\x{200B}"));
+ ok($Collator->eq("\x{313}", "\x{343}"));
+ ok($Collator->eq("\x{2000}", "\x{2001}"));
+ ok($Collator->eq("\x{200B}", "\x{200C}"));
+ ok($Collator->eq("\x{304C}", "\x{304B}\x{3099}"));
+} else {
+ ok(1) for 1..10;
+}
+
+$Collator->change(normalization => undef, identical => 1);
+
+##### 32
+
+ok($Collator->viewSortKey("\0"), '[| | | | 0000 0000]');
+ok($Collator->viewSortKey("\x{200B}"), '[| | | | 0000 200B]');
+
+ok($Collator->viewSortKey('a'),
+ '[0A15 | 0020 | 0002 | FFFF | 0000 0061]');
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926 | 0020 013D | 000E 0002 | FFFF FFFF | 0000 304C]');
+
+ok($Collator->viewSortKey("\x{100000}"),
+ '[FBE0 8000 | 0020 | 0002 | FFFF FFFF | 0010 0000]');
+
+eval { require Unicode::Normalize };
+if (!$@) {
+ $Collator->change(normalization => "NFD");
+
+ ok($Collator->viewSortKey("\x{304C}"),
+ '[1926 | 0020 013D | 000E 0002 | FFFF FFFF | 0000 304B 0000 3099]');
+} else {
+ ok(1);
+}
+
+$Collator->change(normalization => undef);
+
+##### 38
+
+$Collator->change(level => 3);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926 | 0020 013D | 000E 0002 | | 0000 304C]');
+
+$Collator->change(level => 2);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926 | 0020 013D | | | 0000 304C]');
+
+$Collator->change(level => 1);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926 | | | | 0000 304C]');
+
+##### 41
+
+$Collator->change(UCA_Version => 8);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926||||0000 304C]');
+
+$Collator->change(level => 2);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926|0020 013D|||0000 304C]');
+
+$Collator->change(level => 3);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926|0020 013D|000E 0002||0000 304C]');
+
+$Collator->change(level => 4);
+
+ok($Collator->viewSortKey("\x{304C}"),
+ '[1926|0020 013D|000E 0002|FFFF FFFF|0000 304C]');
+
+##### 45
use strict;
use warnings;
-BEGIN { $| = 1; print "1..71\n"; }
+BEGIN { $| = 1; print "1..91\n"; }
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
ok(1);
-#########################
-
our $IsEBCDIC = ord("A") != 0x41;
my $Collator = Unicode::Collate->new(
normalization => undef,
);
-##############
+##### 1
my %old_level = $Collator->change(level => 2);
ok($str, $orig);
-##############
+##### 3
my $match;
}
ok($match, $ret);
-##############
+##### 9
$Collator->change(level => 1);
}
ok($match, undef);
-##############
+##### 13
$Collator->change(level => 1);
}
ok($match, $ret);
-##############
+##### 16
$Collator->change(level => 1);
$Collator->change(%old_level);
-##############
+##### 22
my @ret;
$Collator->change(%old_level);
-##############
+##### 38
$Collator->change(level => 1);
ok($str, "<b>Camel</b> donkey zebra <b>came\x{301}l</b> "
. "<b>CAMEL</b> horse <b>cAm\0E\0L</b>...");
+##### 47
+
# http://www.xray.mpe.mpg.de/mailing-lists/perl-unicode/2010-09/msg00014.html
# when the substring includes an ignorable element like a space...
$Collator->gsubst($str, "ca\x{300}melho\x{302}rse", sub { "=$_[0]=" });
ok($str, "Camel donkey zebra camex{301}l =CAMEL horse= =cAmEL-horse=...");
+##### 53
+
$Collator->change(level => 3);
$str = "P\cBe\x{300}\cBrl and PERL.";
$Collator->change(%old_level);
-##############
+##### 61
$str = "Perl and Camel";
$ret = $Collator->gsubst($str, "\cA\cA\0", "AB");
ok($ret, 2);
ok($str, "ABCABCP");
-##############
+##### 69
# Shifted; ignorable after variable
($ret) = $Collator->match("A?\x{300}!\x{301}B\x{315}", "?!");
ok($ret, undef);
+##### 71
+
+# Now preprocess is defined.
+
+$Collator->change(preprocess => sub {''});
+
+eval { $Collator->index("", "") };
+ok($@ && $@ =~ /Don't use Preprocess with index\(\)/);
+
+eval { $Collator->index("a", "a") };
+ok($@ && $@ =~ /Don't use Preprocess with index\(\)/);
+
+eval { $Collator->match("", "") };
+ok($@ && $@ =~ /Don't use Preprocess with.*match\(\)/);
+
+eval { $Collator->match("a", "a") };
+ok($@ && $@ =~ /Don't use Preprocess with.*match\(\)/);
+
+$Collator->change(preprocess => sub { uc shift });
+
+eval { $Collator->index("", "") };
+ok($@ && $@ =~ /Don't use Preprocess with index\(\)/);
+
+eval { $Collator->index("a", "a") };
+ok($@ && $@ =~ /Don't use Preprocess with index\(\)/);
+
+eval { $Collator->match("", "") };
+ok($@ && $@ =~ /Don't use Preprocess with.*match\(\)/);
+
+eval { $Collator->match("a", "a") };
+ok($@ && $@ =~ /Don't use Preprocess with.*match\(\)/);
+
+##### 79
+
+eval { require Unicode::Normalize };
+my $has_norm = !$@;
+
+if ($has_norm) {
+ # Now preprocess and normalization are defined.
+
+ $Collator->change(normalization => 'NFD');
+
+ eval { $Collator->index("", "") };
+ ok($@ && $@ =~ /Don't use Preprocess with index\(\)/);
+
+ eval { $Collator->index("a", "a") };
+ ok($@ && $@ =~ /Don't use Preprocess with index\(\)/);
+
+ eval { $Collator->match("", "") };
+ ok($@ && $@ =~ /Don't use Preprocess with.*match\(\)/);
+
+ eval { $Collator->match("a", "a") };
+ ok($@ && $@ =~ /Don't use Preprocess with.*match\(\)/);
+} else {
+ ok(1) for 1..4;
+}
+
+$Collator->change(preprocess => undef);
+
+if ($has_norm) {
+ # Now only normalization is defined.
+
+ eval { $Collator->index("", "") };
+ ok($@ && $@ =~ /Don't use Normalization with index\(\)/);
+
+ eval { $Collator->index("a", "a") };
+ ok($@ && $@ =~ /Don't use Normalization with index\(\)/);
+
+ eval { $Collator->match("", "") };
+ ok($@ && $@ =~ /Don't use Normalization with.*match\(\)/);
+
+ eval { $Collator->match("a", "a") };
+ ok($@ && $@ =~ /Don't use Normalization with.*match\(\)/);
+
+ $Collator->change(normalization => undef);
+} else {
+ ok(1) for 1..4;
+}
+
+##### 87
+
+# Now preprocess and normalization are undef.
+
+eval { $Collator->index("", "") };
+ok(!$@);
+
+eval { $Collator->index("a", "a") };
+ok(!$@);
+
+eval { $Collator->match("", "") };
+ok(!$@);
+
+eval { $Collator->match("a", "a") };
+ok(!$@);
+
+##### 91
use strict;
use warnings;
-BEGIN { $| = 1; print "1..285\n"; } # 6 + 31 x @Versions
+BEGIN { $| = 1; print "1..316\n"; } # 6 + 31 x @Versions
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
# 2A700..2B734 are CJK UI Ext.C since UCA_Version 20 (Unicode 5.2).
# 2B740..2B81D are CJK UI Ext.D since UCA_Version 22 (Unicode 6.0).
-my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24);
+my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24, 26);
for my $v (@Versions) {
$ignoreCJK->change(UCA_Version => $v);
use strict;
use warnings;
-BEGIN { $| = 1; print "1..155\n"; } # 11 + 16 x @Versions
+BEGIN { $| = 1; print "1..171\n"; } # 11 + 16 x @Versions
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
# 9FC4..9FCB are CJK UI since UCA_Version 20 (Unicode 5.2).
# 9FCC is CJK UI since UCA_Version 24 (Unicode 6.1).
-my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24);
+my @Versions = (8, 9, 11, 14, 16, 18, 20, 22, 24, 26);
for my $v (@Versions) {
$overCJK->change(UCA_Version => $v);
use strict;
use warnings;
-BEGIN { $| = 1; print "1..107\n"; }
+BEGIN { $| = 1; print "1..112\n"; }
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
@temp = $c->index("perl5", "LR");
ok($_, 'Foo');
-#####
+##### 108..109
+
+{
+ my $caseless = Unicode::Collate->new(
+ table => "keys.txt",
+ normalization => undef,
+ preprocess => sub { uc shift },
+ );
+ ok( $Collator->gt("ABC","abc") );
+ ok( $caseless->eq("ABC","abc") );
+}
+##### 110..112
+
+{
+ eval { require Unicode::Normalize; };
+ if ($@) {
+ eval { my $n1 = Unicode::Collate->new(table => "keys.txt"); };
+ ok($@ =~ /Unicode::Normalize is required/);
+
+ eval { my $n2 = Unicode::Collate->new
+ (table => "keys.txt", normalization => undef); };
+ ok(!$@);
+
+ eval { my $n3 = Unicode::Collate->new
+ (table => "keys.txt", normalization => 'prenormalized'); };
+ ok($@ =~ /Unicode::Normalize is required/);
+ } else {
+ ok(1) for 1..3;
+ }
+}
+
+#####
use strict;
use warnings;
-BEGIN { $| = 1; print "1..53\n"; }
+BEGIN { $| = 1; print "1..89\n"; }
my $count = 0;
sub ok ($;$) {
my $p = my $r = shift;
ok(1);
-#########################
+##### 1
my $Collator = Unicode::Collate->new(
table => 'keys.txt',
normalization => undef,
+ UCA_Version => 24,
);
-##############
-
ok($Collator->viewSortKey(""), "[| | |]");
ok($Collator->viewSortKey("A"), "[0A15 | 0020 | 0008 | FFFF]");
$Collator->change(level => 1);
ok($Collator->viewSortKey("A"), "[0A15 | | |]");
-### Version 8
+##### 10
$Collator->change(level => 4, UCA_Version => 8);
$Collator->change(level => 1);
ok($Collator->viewSortKey("A"), "[0A15|||]");
-# Version 9
+##### 19
$Collator->change(level => 3, UCA_Version => 9);
ok($Collator->viewSortKey("A\x{300}z\x{301}"),
$Collator->change(%origVar);
-#####
+##### 37
# Level 3 weight
ok($Collator->viewSortKey("A\x{30A2}"),
'[0A15 1921 | 0020 0020 | 0008 0011 | FFFF FFFF]');
-#####
+##### 47
our $el = Unicode::Collate->new(
entry => <<'ENTRY',
ENTRY
table => undef,
normalization => undef,
+ UCA_Version => 24,
);
our $el12 = '0B03 0B03 0B03 0B03 0B03 | 0020 0020 0020 0020 0020';
ok($el->viewSortKey("L\x{FF2C}\x{216C}\x{2112}\x{24C1}"),
"[$el12 | 0008 0009 000A 000B 000C | FFFF FFFF FFFF FFFF FFFF]");
-#####
+##### 53
+
+my @Versions = (9, 11, 14, 16, 18, 20, 22, 24, 26);
+
+for my $v (@Versions) {
+ $Collator->change(UCA_Version => $v);
+ my $app = $v >= 26 ? ' |]' : ']';
+
+ $Collator->change(variable => 'Shifted', level => 4);
+ ok($Collator->viewSortKey("1+2"),
+ '[0A0C 0A0D | 0020 0020 | 0002 0002 | FFFF 039F FFFF'.$app);
+
+ $Collator->change(variable => 'Shift-Trimmed');
+ ok($Collator->viewSortKey("1+2"),
+ '[0A0C 0A0D | 0020 0020 | 0002 0002 | 039F'.$app);
+
+ $Collator->change(variable => 'Non-ignorable', level => 3);
+ ok($Collator->viewSortKey("1+2"),
+ '[0A0C 039F 0A0D | 0020 0020 0020 | 0002 0002 0002 |]');
+
+ $Collator->change(variable => 'Blanked');
+ ok($Collator->viewSortKey("1+2"),
+ '[0A0C 0A0D | 0020 0020 | 0002 0002 |]');
+}
+
+##### 89
projects / platform / upstream / perl.git / commitdiff