This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Unicode::Collate from version 1.04 to 1.07
authorSteve Hay <steve.m.hay@googlemail.com>
Wed, 28 May 2014 11:37:53 +0000 (12:37 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Wed, 28 May 2014 15:58:07 +0000 (16:58 +0100)
Porting/Maintainers.pl
cpan/Unicode-Collate/Collate.pm
cpan/Unicode-Collate/Collate.xs
cpan/Unicode-Collate/t/contract.t
pod/perldelta.pod

index 1464776..f573f88 100755 (executable)
@@ -1225,7 +1225,7 @@ use File::Glob qw(:case);
     },
 
     'Unicode::Collate' => {
-        'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-1.04.tar.gz',
+        'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-1.07.tar.gz',
         'FILES'        => q[cpan/Unicode-Collate],
         'EXCLUDED'     => [
             qr{N$},
index 0fd2951..a67cbdf 100644 (file)
@@ -17,7 +17,7 @@ use File::Spec;
 
 no warnings 'utf8';
 
-our $VERSION = '1.04';
+our $VERSION = '1.07';
 our $PACKAGE = __PACKAGE__;
 
 ### begin XS only ###
@@ -117,6 +117,7 @@ our @ChangeOK = qw/
     katakana_before_hiragana upper_before_lower ignore_level2
     overrideCJK overrideHangul overrideOut preprocess UCA_Version
     hangul_terminator variable identical highestFFFF minimalFFFE
+    long_contraction
   /;
 
 our @ChangeNG = qw/
@@ -285,6 +286,7 @@ sub new
        }
     }
 
+    # only in new(), not in change()
     $self->{level} ||= MaxLevel;
     $self->{UCA_Version} ||= UCA_Version();
 
@@ -299,7 +301,10 @@ sub new
        if ! exists $self->{rearrange};
     $self->{backwards} = $self->{backwardsTable}
        if ! exists $self->{backwards};
+    exists $self->{long_contraction} or $self->{long_contraction}
+       = 22 <= $self->{UCA_Version} && $self->{UCA_Version} <= 24;
 
+    # checkCollator() will be called in change()
     $self->checkCollator();
 
     return $self;
@@ -441,12 +446,10 @@ sub parseEntry
            $self->{maxlength}{$uv[0]} = @uv;
        }
     }
-    if (@uv > 2) {
-       while (@uv) {
-           pop @uv;
-           my $fake_entry = join(CODE_SEP, @uv); # in JCPS
-           $self->{contraction}{$fake_entry} = 1;
-       }
+    while (@uv > 2) {
+       pop @uv;
+       my $fake_entry = join(CODE_SEP, @uv); # in JCPS
+       $self->{contraction}{$fake_entry} = 1;
     }
 }
 
@@ -486,6 +489,7 @@ sub splitEnt
     my $reH  = $self->{rearrangeHash};
     my $vers = $self->{UCA_Version};
     my $ver9 = $vers >= 9 && $vers <= 11;
+    my $long = $self->{long_contraction};
     my $uXS  = $self->{__useXS}; ### XS only
 
     my @buf;
@@ -566,6 +570,15 @@ sub splitEnt
                    last unless $curCC;
                    my $tail = CODE_SEP . $src[$p];
 
+                   if ($preCC != $curCC && $map->{$jcps.$tail}) {
+                       $jcps .= $tail;
+                       push @out, $p;
+                   } else {
+                       $preCC = $curCC;
+                   }
+
+                   next if !$long;
+
                    if ($preCC_uc != $curCC && ($map->{$jcps_uc.$tail} ||
                                               $cont->{$jcps_uc.$tail})) {
                        $jcps_uc .= $tail;
@@ -573,16 +586,9 @@ sub splitEnt
                    } else {
                        $preCC_uc = $curCC;
                    }
-
-                   if ($preCC != $curCC && $map->{$jcps.$tail}) {
-                       $jcps .= $tail;
-                       push @out, $p;
-                   } else {
-                       $preCC = $curCC;
-                   }
                }
 
-               if ($map->{$jcps_uc}) {
+               if (@out_uc && $map->{$jcps_uc}) {
                    $jcps = $jcps_uc;
                    $src[$_] = undef for @out_uc;
                } else {
@@ -1068,6 +1074,7 @@ with no parameters, the collator should do the default collation.
       ignore_level2 => $bool,
       katakana_before_hiragana => $bool,
       level => $collationLevel,
+      long_contraction => $bool,
       minimalFFFE => $bool,
       normalization  => $normalization_form,
       overrideCJK => \&overrideCJK,
@@ -1107,6 +1114,8 @@ The following revisions are supported.  The default is 28.
      26             6.2.0               6.2.0 (6.2.0)
      28             6.3.0               6.3.0 (6.3.0)
 
+* See below C<long_contraction> with C<UCA_Version> 22 and 24.
+
 * Noncharacters (e.g. U+FFFF) are not ignored, and can be overridden
 since C<UCA_Version> 22.
 
@@ -1144,7 +1153,7 @@ forwards at all the levels.
 
 =item entry
 
--- see 5 Tailoring; 3.6.1 File Format, UTS #10.
+-- see 5 Tailoring; 9.1 Allkeys File Format, UTS #10.
 
 If the same character (or a sequence of characters) exists
 in the collation element table through C<table>,
@@ -1261,7 +1270,7 @@ of the string after them (in NFD by default) are used.
 
 =item ignoreName
 
--- see 3.6.2 Variable Weighting, UTS #10.
+-- see 3.6 Variable Weighting, UTS #10.
 
 Makes the entry in the table completely ignorable;
 i.e. as if the weights were zero at all level.
@@ -1322,6 +1331,46 @@ and 'shift-trimmed'), the level 4 may be unreliable.
 
 See also C<identical>.
 
+=item long_contraction
+
+-- see 3.8.2 Well-Formedness of the DUCET, 4.2 Produce Array, UTS #10.
+
+If the parameter is made true, for a contraction with three or more
+characters (here nicknamed "long contraction"), initial substrings
+will be handled.
+For example, a contraction ABC, where A is a starter, and B and C
+are non-starters (character with non-zero combining character class),
+will be detected even if there is not AB as a contraction.
+
+B<Default:> Usually false.
+If C<UCA_Version> is 22 or 24, and the value of C<long_contraction>
+is not specified in C<new()>, a true value is set implicitly.
+This is a workaround to pass Conformance Tests for Unicode 6.0.0 and 6.1.0.
+
+C<change()> handles C<long_contraction> explicitly only.
+If C<long_contraction> is not specified in C<change()>, even though
+C<UCA_Version> is changed, C<long_contraction> will not be changed.
+
+B<Limitation:> Scanning non-starters is one-way (no back tracking).
+If AB is found but not ABC is not found, other long contraction where
+the first character is A and the second is not B may not be found.
+
+Under C<(normalization =E<gt> undef)>, detection step of discontiguous
+contractions are skipped.
+
+B<Note:> The following contractions in DUCET are not considered
+in steps S2.1.1 to S2.1.3, where they are discontiguous.
+
+    0FB2 0F71 0F80 (TIBETAN VOWEL SIGN VOCALIC RR)
+    0FB3 0F71 0F80 (TIBETAN VOWEL SIGN VOCALIC LL)
+
+For example C<TIBETAN VOWEL SIGN VOCALIC RR> with C<COMBINING TILDE OVERLAY>
+(C<U+0344>) is C<0FB2 0344 0F71 0F80> in NFD.
+In this case C<0FB2 0F80> (C<TIBETAN VOWEL SIGN VOCALIC R>) is detected,
+instead of C<0FB2 0F71 0F80>.
+Inserted C<0344> makes C<0FB2 0F71 0F80> discontiguous and lack of
+contraction C<0FB2 0F71> prohibits C<0FB2 0F71 0F80> from being detected.
+
 =item minimalFFFE
 
 -- see 5.14 Collation Elements, UTS #35.
@@ -1615,7 +1664,7 @@ B<NOTE>: Contractions via C<entry> are not be suppressed.
 
 =item table
 
--- see 3.6 Default Unicode Collation Element Table, UTS #10.
+-- see 3.8 Default Unicode Collation Element Table, UTS #10.
 
 You can use another collation element table if desired.
 
@@ -1694,7 +1743,7 @@ this parameter doesn't work validly.
 
 =item variable
 
--- see 3.6.2 Variable Weighting, UTS #10.
+-- see 3.6 Variable Weighting, UTS #10.
 
 This key allows for variable weighting of variable collation elements,
 which are marked with an ASTERISK in the table
@@ -2029,7 +2078,7 @@ B<Unicode::Normalize is required to try The Conformance Test.>
 =head1 AUTHOR, COPYRIGHT AND LICENSE
 
 The Unicode::Collate module for perl was written by SADAHIRO Tomoyuki,
-<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2013,
+<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2014,
 SADAHIRO Tomoyuki. Japan. All rights reserved.
 
 This module is free software; you can redistribute it and/or
index af62d0b..ed0074b 100644 (file)
@@ -11,9 +11,9 @@
 #include "ucatbl.h"
 
 /* Perl 5.6.1 ? */
-#ifndef utf8n_to_uvuni
+#ifdef utf8_to_uv
 #define utf8n_to_uvuni  utf8_to_uv
-#endif /* utf8n_to_uvuni */
+#endif /* utf8_to_uv */
 
 /* UTF8_ALLOW_BOM is used before Perl 5.8.0 */
 #ifndef UTF8_ALLOW_BOM
@@ -590,36 +590,28 @@ varCE (self, vce)
     /* variable: checked only the first char and the length,
        trusting checkCollator() and %VariableOK in Perl ... */
 
-    if (vlen < VCE_Length /* ignore short VCE (unexpected) */
-       ||
-       *a == 'n') /* non-ignorable */
-       1;
-    else if (*v) {
-       if (*a == 's') { /* shifted or shift-trimmed */
-           d[7] = d[1]; /* wt level 1 to 4 */
-           d[8] = d[2];
-       } /* else blanked */
-
-       d[1] = d[2] = d[3] = d[4] = d[5] = d[6] = '\0';
-    }
-    else if (*a == 'b') /* blanked */
-       1;
-    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 */
-           if (d[1] == 0 && d[2] == 1) { /* XXX: CollationAuxiliary-6.2.0 */
+    if (vlen >= VCE_Length && *a != 'n') {
+       if (*v) {
+           if (*a == 's') { /* shifted or shift-trimmed */
                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 blanked */
+           d[1] = d[2] = d[3] = d[4] = d[5] = d[6] = '\0';
+       } 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 */
+               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 or completely ignorable */
+               d[7] = d[8] = '\0';
            }
-       } else { /* shift-trimmed or completely ignorable */
-           d[7] = d[8] = '\0';
-       }
-    }
-    else
-       croak("unknown variable value '%s'", a);
+       } /* else blanked */
+    } /* else non-ignorable */
     RETVAL = dst;
 OUTPUT:
     RETVAL
index d659562..cec3c80 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict;
 use warnings;
-BEGIN { $| = 1; print "1..74\n"; }
+BEGIN { $| = 1; print "1..108\n"; }
 my $count = 0;
 sub ok ($;$) {
     my $p = my $r = shift;
@@ -179,7 +179,9 @@ ok($kjeSup->eq("\x{40C}", "\x{41A}\x{301}"));
 # 44
 
 our $tibetanEntry = <<'ENTRIES';
-0000  ; [.0000.0000.0000.0000] # [0000] NULL (in 6429)
+0000           ; [.0000.0000.0000.0000] # [0000] NULL (in 6429)
+0FB2           ; [.205B.0020.0002.0FB2] # TIBETAN SUBJOINED LETTER RA
+0FB3           ; [.205E.0020.0002.0FB3] # TIBETAN SUBJOINED LETTER LA
 0F71           ; [.206D.0020.0002.0F71] # TIBETAN VOWEL SIGN AA
 0F72           ; [.206E.0020.0002.0F72] # TIBETAN VOWEL SIGN I
 0F73           ; [.206F.0020.0002.0F73] # TIBETAN VOWEL SIGN II
@@ -215,6 +217,7 @@ if (!$@) {
     my $tibNFD = Unicode::Collate->new(
        table => undef,
        entry => $tibetanEntry,
+       UCA_Version => 24,
     );
 
     # VOCALIC RR
@@ -251,8 +254,43 @@ if (!$@) {
     ok($tibNFD->eq("\x{F79}\0\x{334}", "\x{FB3}\x{F80}\x{F71}\0\x{334}"));
 # 72
 
+    my $a1 = "\x{FB2}\x{334}\x{F81}";
+    my $b1 = "\x{F77}\0\x{334}";
+    my $a2 = "\x{FB2}\x{334}\x{F81}";
+    my $b2 = "\x{FB2}\x{F80}\0\x{334}\x{F71}";
+
+    for my $v (qw/20 22 24 26 28/) {
+       my $tib = Unicode::Collate->new(
+           table => undef,
+           entry => $tibetanEntry,
+           UCA_Version => $v,
+       );
+       my $long = 22 <= $v && $v <= 24;
+       ok($tib->cmp($a1, $b1), $long ? 0 : -1);
+       ok($tib->cmp($a2, $b2), $long ? 1 : 0);
+
+       $tib->change(long_contraction => 0);
+       ok($tib->cmp($a1, $b1), -1);
+       ok($tib->cmp($a2, $b2),  0);
+
+       $tib->change(long_contraction => 1);
+       ok($tib->cmp($a1, $b1), 0);
+       ok($tib->cmp($a2, $b2), 1);
+    }
+# 102
+
+    # UCA_Version => 22
+    ok($tibNFD->cmp($a1, $b1), 0);
+    ok($tibNFD->cmp($a2, $b2), 1);
+
+    $tibNFD->change(UCA_Version => 26); # not affect long_contraction
+    ok($tibNFD->cmp($a1, $b1), 0);
+    ok($tibNFD->cmp($a2, $b2), 1);
+# 106
+
     my $discontNFD = Unicode::Collate->new(
        table => undef,
+       UCA_Version => 22,
        entry => <<'ENTRIES',
 0000  ; [.0000.0000.0000.0000] # [0000] NULL (in 6429)
 0301  ; [.0000.0032.0002.0301] # COMBINING ACUTE ACCENT
@@ -268,6 +306,6 @@ ENTRIES
     ok($discontNFD->eq("A\x{327}\x{301}\0\x{334}", "A\x{334}\x{327}\x{301}"));
     ok($discontNFD->eq("A\x{300}\0\x{327}",        "A\x{327}\x{300}"));
 } else {
-    ok(1) for 1..30;
+    ok(1) for 1..64;
 }
-# 74
+# 108
index a6fb62e..7a67df4 100644 (file)
@@ -157,6 +157,13 @@ L<Term::Cap> has been upgraded from version 1.15 to 1.16.
 
 The last resort attempt to fake up a termcap from terminfo now works.
 
+=item *
+
+L<Unicode::Collate> has been upgraded from version 1.04 to 1.07.
+
+Version 0.67's improved discontiguous contractions is invalidated by default
+and is supported as a parameter 'long_contraction'.
+
 =back
 
 =head2 Removed Modules and Pragmata