This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Unicode-Collate to CPAN version 1.04
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Sat, 7 Dec 2013 09:40:43 +0000 (09:40 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Sat, 7 Dec 2013 09:40:43 +0000 (09:40 +0000)
  [DELTA]

1.04  Sat Dec  7 11:34:18 2013
    - XS: a workaround for perl 5.6.x to handle U+FFFF correctly.
      unpack_U() is implemented by using XS again as well as that in 1.02,
      but now that is used only in the versions before perl 5.8.0.

Porting/Maintainers.pl
cpan/Unicode-Collate/Collate.pm
cpan/Unicode-Collate/Collate.xs

index 2e13c08..78c4089 100755 (executable)
@@ -1233,7 +1233,7 @@ use File::Glob qw(:case);
     },
 
     'Unicode::Collate' => {
-        'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-1.03.tar.gz',
+        'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-1.04.tar.gz',
         'FILES'        => q[cpan/Unicode-Collate],
         'EXCLUDED'     => [
             qr{N$},
index 7eda04b..0fd2951 100644 (file)
@@ -17,7 +17,7 @@ use File::Spec;
 
 no warnings 'utf8';
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 our $PACKAGE = __PACKAGE__;
 
 ### begin XS only ###
@@ -99,9 +99,11 @@ sub pack_U {
     return pack('U*', @_);
 }
 
-sub unpack_U {
-    return unpack('U*', shift(@_).pack('U*'));
-}
+### begin XS only ###
+*unpack_U = exists &Unicode::Collate::bootstrap &&
+       $] < 5.008 && \&unpackUfor56 && 0x41 == unpackUfor56('A')
+    ? \&unpackUfor56 : sub { return unpack('U*', shift(@_).pack('U*')) };
+### end XS only ###
 
 ######
 
index 2c0adf8..af62d0b 100644 (file)
 /* This file is prepared by mkheader */
 #include "ucatbl.h"
 
+/* Perl 5.6.1 ? */
+#ifndef utf8n_to_uvuni
+#define utf8n_to_uvuni  utf8_to_uv
+#endif /* utf8n_to_uvuni */
+
+/* UTF8_ALLOW_BOM is used before Perl 5.8.0 */
+#ifndef UTF8_ALLOW_BOM
+#define UTF8_ALLOW_BOM  (0)
+#endif /* UTF8_ALLOW_BOM */
+
+#ifndef UTF8_ALLOW_SURROGATE
+#define UTF8_ALLOW_SURROGATE  (0)
+#endif /* UTF8_ALLOW_SURROGATE */
+
+#ifndef UTF8_ALLOW_FE_FF
+#define UTF8_ALLOW_FE_FF  (0)
+#endif /* UTF8_ALLOW_FE_FF */
+
+#ifndef UTF8_ALLOW_FFFF
+#define UTF8_ALLOW_FFFF  (0)
+#endif /* UTF8_ALLOW_FFFF */
+
+#define AllowAnyUTF (UTF8_ALLOW_SURROGATE|UTF8_ALLOW_BOM|UTF8_ALLOW_FE_FF|UTF8_ALLOW_FFFF)
+
+/* perl 5.6.x workaround, before 5.8.0 */
+#ifdef utf8n_to_uvuni
+#define GET_UV_FOR_5_6 utf8n_to_uvuni(p, e - p, &retlen, AllowAnyUTF)
+#else
+#define GET_UV_FOR_5_6 retlen = 1 /* avoid an infinite loop */
+#endif /* utf8n_to_uvuni */
+
 /* At present, char > 0x10ffff are unaffected without complaint, right? */
 #define VALID_UTF_MAX    (0x10ffff)
 #define OVER_UTF_MAX(uv) (VALID_UTF_MAX < (uv))
@@ -658,3 +689,30 @@ visualizeSortKey (self, key)
 OUTPUT:
     RETVAL
 
+
+
+void
+unpackUfor56 (src)
+    SV* src
+  PREINIT:
+    STRLEN srclen, retlen;
+    U8 *s, *p, *e;
+    UV uv;
+  PPCODE:
+    s = (U8*)SvPV(src,srclen);
+    if (!SvUTF8(src)) {
+       SV* tmpsv = sv_mortalcopy(src);
+       if (!SvPOK(tmpsv))
+           (void)sv_pvn_force(tmpsv,&srclen);
+       sv_utf8_upgrade(tmpsv);
+       s = (U8*)SvPV(tmpsv,srclen);
+    }
+    e = s + srclen;
+
+    for (p = s; p < e; p += retlen) {
+       uv = GET_UV_FOR_5_6; /* perl 5.6.x workaround */
+       if (!retlen)
+           croak("panic (Unicode::Collate): zero-length character");
+       XPUSHs(sv_2mortal(newSVuv(uv)));
+    }
+