Comment on comment.

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

diff --git a/utf8.c b/utf8.c
index 8ce0d21..3bbfdf1 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -69,7 +69,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
        return d;
     }
 #ifdef HAS_QUAD
-    if (uv < 0x1000000000LL)
+    if (uv < UTF8_QUAD_MAX)
 #endif
     {
        *d++ =                        0xfe;     /* Can't match U+FEFF! */
@@ -192,9 +192,20 @@ Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
     dTHR;
     UV uv = *s, ouv;
     STRLEN len = 1;
+#ifdef EBCDIC
+    bool dowarn = 0;
+#else
     bool dowarn = ckWARN_d(WARN_UTF8);
+#endif
     STRLEN expectlen = 0;
     
+    if (curlen == 0) {
+       if (dowarn)
+           Perl_warner(aTHX_ WARN_UTF8,
+                       "Malformed UTF-8 character (an empty string)");
+       goto malformed;
+    }
+
     if (uv <= 0x7f) { /* Pure ASCII. */
        if (retlen)
            *retlen = 1;
@@ -210,7 +221,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
        goto malformed;
     }
 
-    if ((uv >= 0xc0 && uv <= 0xfd && curlen >1 && s[1] < 0x80) &&
+    if ((uv >= 0xc0 && uv <= 0xfd && curlen > 1 && s[1] < 0x80) &&
        !(flags & UTF8_ALLOW_NON_CONTINUATION)) {
        if (dowarn)
            Perl_warner(aTHX_ WARN_UTF8,
@@ -246,7 +257,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
        if (dowarn)
            Perl_warner(aTHX_ WARN_UTF8,
                        "Malformed UTF-8 character (%d byte%s, need %d)",
-                       curlen, curlen > 1 ? "s" : "", expectlen);
+                       curlen, curlen == 1 ? "" : "s", expectlen);
        goto malformed;
     }
 
@@ -302,7 +313,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
        if (dowarn)
            Perl_warner(aTHX_ WARN_UTF8,
                        "Malformed UTF-8 character (%d byte%s, need %d)",
-                       expectlen, expectlen > 1 ? "s": "", UNISKIP(uv));
+                       expectlen, expectlen == 1 ? "": "s", UNISKIP(uv));
        goto malformed;
     }
 
@@ -312,12 +323,12 @@ malformed:
 
     if (flags & UTF8_CHECK_ONLY) {
        if (retlen)
-           *retlen = len;
+           *retlen = -1;
        return 0;
     }
 
     if (retlen)
-       *retlen = -1;
+       *retlen = expectlen ? expectlen : len;
 
     return UNICODE_REPLACEMENT_CHARACTER;
 }
@@ -342,25 +353,64 @@ Perl_utf8_to_uv_simple(pTHX_ U8* s, STRLEN* retlen)
     return Perl_utf8_to_uv(aTHX_ s, (STRLEN)-1, retlen, 0);
 }
 
+/*
+=for apidoc|utf8_length|U8 *s|U8 *e
+
+Return the length of the UTF-8 char encoded string C<s> in characters.
+Stops at C<e> (inclusive).  If C<e E<lt> s> or if the scan would end
+up past C<e>, croaks.
+
+=cut
+*/
+
+STRLEN
+Perl_utf8_length(pTHX_ U8* s, U8* e)
+{
+    STRLEN len = 0;
+
+    if (e < s)
+       Perl_croak(aTHX_ "panic: utf8_length: unexpected end");
+    while (s < e) {
+       U8 t = UTF8SKIP(s);
+
+       if (e - s < t)
+           Perl_croak(aTHX_ "panic: utf8_length: unaligned end");
+       s += t;
+       len++;
+    }
+
+    return len;
+}
+
 /* utf8_distance(a,b) returns the number of UTF8 characters between
    the pointers a and b                                                        */
 
-I32
+IV
 Perl_utf8_distance(pTHX_ U8 *a, U8 *b)
 {
-    I32 off = 0;
+    IV off = 0;
+
     if (a < b) {
        while (a < b) {
-           a += UTF8SKIP(a);
+           U8 c = UTF8SKIP(a);
+
+           if (b - a < c)
+               Perl_croak(aTHX_ "panic: utf8_distance: unaligned end");
+           a += c;
            off--;
        }
     }
     else {
        while (b < a) {
-           b += UTF8SKIP(b);
+           U8 c = UTF8SKIP(b);
+
+           if (a - b < c)
+               Perl_croak(aTHX_ "panic: utf8_distance: unaligned end");
+           b += c;
            off++;
        }
     }
+
     return off;
 }
 
@@ -950,7 +1000,7 @@ Perl_to_utf8_upper(pTHX_ U8 *p)
     if (!PL_utf8_toupper)
        PL_utf8_toupper = swash_init("utf8", "ToUpper", &PL_sv_undef, 4, 0);
     uv = swash_fetch(PL_utf8_toupper, p);
-    return uv ? uv : utf8_to_uv(p,STRLEN_MAX,0,0);
+    return uv ? uv : utf8_to_uv(p,UTF8_MAXLEN,0,0);
 }
 
 UV
@@ -961,7 +1011,7 @@ Perl_to_utf8_title(pTHX_ U8 *p)
     if (!PL_utf8_totitle)
        PL_utf8_totitle = swash_init("utf8", "ToTitle", &PL_sv_undef, 4, 0);
     uv = swash_fetch(PL_utf8_totitle, p);
-    return uv ? uv : utf8_to_uv(p,STRLEN_MAX,0,0);
+    return uv ? uv : utf8_to_uv(p,UTF8_MAXLEN,0,0);
 }
 
 UV
@@ -972,7 +1022,7 @@ Perl_to_utf8_lower(pTHX_ U8 *p)
     if (!PL_utf8_tolower)
        PL_utf8_tolower = swash_init("utf8", "ToLower", &PL_sv_undef, 4, 0);
     uv = swash_fetch(PL_utf8_tolower, p);
-    return uv ? uv : utf8_to_uv(p,STRLEN_MAX,0,0);
+    return uv ? uv : utf8_to_uv(p,UTF8_MAXLEN,0,0);
 }
 
 /* a "swash" is a swatch hash */
@@ -1062,7 +1112,7 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr)
            PUSHMARK(SP);
            EXTEND(SP,3);
            PUSHs((SV*)sv);
-           PUSHs(sv_2mortal(newSViv(utf8_to_uv(ptr, STRLEN_MAX, 0, 0) & ~(needents - 1))));
+           PUSHs(sv_2mortal(newSViv(utf8_to_uv(ptr, UTF8_MAXLEN, 0, 0) & ~(needents - 1))));
            PUSHs(sv_2mortal(newSViv(needents)));
            PUTBACK;
            if (call_method("SWASHGET", G_SCALAR))
@@ -1089,7 +1139,7 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr)
            Copy(ptr, PL_last_swash_key, klen, U8);
     }
 
-    switch ((slen << 3) / needents) {
+    switch ((int)((slen << 3) / needents)) {
     case 1:
        bit = 1 << (off & 7);
        off >>= 3;