Upgrade to Encode 1.11, from Dan Kogai.

[p5sagit/p5-mst-13.2.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index 6fc4acd..85a22a1 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -24,6 +24,8 @@
 #define PERL_IN_UTF8_C
 #include "perl.h"
 
+static char unees[] = "Malformed UTF-8 character (unexpected end of string)";
+
 /* 
 =head1 Unicode Support
 
@@ -57,7 +59,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
     if (ckWARN(WARN_UTF8)) {
         if (UNICODE_IS_SURROGATE(uv) &&
             !(flags & UNICODE_ALLOW_SURROGATE))
-             Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv);
+             Perl_warner(aTHX_ packWARN(WARN_UTF8), "UTF-16 surrogate 0x%04"UVxf, uv);
         else if (
                  ((uv >= 0xFDD0 && uv <= 0xFDEF &&
                    !(flags & UNICODE_ALLOW_FDD0))
@@ -72,7 +74,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
                  ((uv <= PERL_UNICODE_MAX) ||
                   !(flags & UNICODE_ALLOW_SUPER))
                  )
-             Perl_warner(aTHX_ WARN_UTF8,
+             Perl_warner(aTHX_ packWARN(WARN_UTF8),
                         "Unicode character 0x%04"UVxf" is illegal", uv);
     }
     if (UNI_IS_INVARIANT(uv)) {
@@ -469,10 +471,10 @@ malformed:
            char *s = SvPVX(sv);
 
            if (PL_op)
-               Perl_warner(aTHX_ WARN_UTF8,
+               Perl_warner(aTHX_ packWARN(WARN_UTF8),
                            "%s in %s", s,  OP_DESC(PL_op));
            else
-               Perl_warner(aTHX_ WARN_UTF8, "%s", s);
+               Perl_warner(aTHX_ packWARN(WARN_UTF8), "%s", s);
        }
     }
 
@@ -543,13 +545,29 @@ Perl_utf8_length(pTHX_ U8 *s, U8 *e)
      * the bitops (especially ~) can create illegal UTF-8.
      * In other words: in Perl UTF-8 is not just for Unicode. */
 
-    if (e < s)
-       Perl_croak(aTHX_ "panic: utf8_length: unexpected end");
+    if (e < s) {
+        if (ckWARN_d(WARN_UTF8)) {
+           if (PL_op)
+               Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                           "%s in %s", unees, OP_DESC(PL_op));
+           else
+               Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+       }
+       return 0;
+    }
     while (s < e) {
        U8 t = UTF8SKIP(s);
 
-       if (e - s < t)
-           Perl_croak(aTHX_ "panic: utf8_length: unaligned end");
+       if (e - s < t) {
+           if (ckWARN_d(WARN_UTF8)) {
+               if (PL_op)
+                   Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                               unees, OP_DESC(PL_op));
+               else
+                   Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+           }
+           return len;
+       }
        s += t;
        len++;
     }
@@ -582,8 +600,16 @@ Perl_utf8_distance(pTHX_ U8 *a, U8 *b)
        while (a < b) {
            U8 c = UTF8SKIP(a);
 
-           if (b - a < c)
-               Perl_croak(aTHX_ "panic: utf8_distance: unaligned end");
+           if (b - a < c) {
+               if (ckWARN_d(WARN_UTF8)) {
+                   if (PL_op)
+                       Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                                   "%s in %s", unees, OP_DESC(PL_op));
+                   else
+                       Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+               }
+               return off;
+           }
            a += c;
            off--;
        }
@@ -592,8 +618,16 @@ Perl_utf8_distance(pTHX_ U8 *a, U8 *b)
        while (b < a) {
            U8 c = UTF8SKIP(b);
 
-           if (a - b < c)
-               Perl_croak(aTHX_ "panic: utf8_distance: unaligned end");
+           if (a - b < c) {
+               if (ckWARN_d(WARN_UTF8)) {
+                   if (PL_op)
+                       Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                                   "%s in %s", unees, OP_DESC(PL_op));
+                   else
+                       Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+               }
+               return off;
+           }
            b += c;
            off++;
        }
@@ -952,33 +986,29 @@ Perl_is_uni_xdigit(pTHX_ UV c)
 UV
 Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return to_utf8_upper(tmpbuf, p, lenp);
+    uvchr_to_utf8(p, c);
+    return to_utf8_upper(p, p, lenp);
 }
 
 UV
 Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return to_utf8_title(tmpbuf, p, lenp);
+    uvchr_to_utf8(p, c);
+    return to_utf8_title(p, p, lenp);
 }
 
 UV
 Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return to_utf8_lower(tmpbuf, p, lenp);
+    uvchr_to_utf8(p, c);
+    return to_utf8_lower(p, p, lenp);
 }
 
 UV
 Perl_to_uni_fold(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return to_utf8_fold(tmpbuf, p, lenp);
+    uvchr_to_utf8(p, c);
+    return to_utf8_fold(p, p, lenp);
 }
 
 /* for now these all assume no locale info available for Unicode > 255 */
@@ -1513,8 +1543,12 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
        Copy(pv, PL_tokenbuf, len+1, char);
        PL_curcop->op_private = PL_hints;
     }
-    if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV)
+    if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
+        if (SvPOK(retval))
+           Perl_croak(aTHX_ "Can't find Unicode property definition \"%s\"",
+                      SvPV_nolen(retval));
        Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");
+    }
     return retval;
 }
 
@@ -1755,7 +1789,7 @@ Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
                 case '\a':
                     Perl_sv_catpvf(aTHX_ dsv, "\\a"); ok = TRUE; break;
                 case '\\':
-                    Perl_sv_catpvf(aTHX_ dsv, "\\" ); ok = TRUE; break;
+                    Perl_sv_catpvf(aTHX_ dsv, "\\\\" ); ok = TRUE; break;
                 default: break;
                 }
             }