Thinko in #7222.

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

diff --git a/utf8.c b/utf8.c
index d23c9f7..a713ea1 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -116,13 +116,7 @@ Perl_is_utf8_char(pTHX_ U8 *s)
     if (!(u & 0x40))
        return 0;
 
-    if      (!(u & 0x20))      { len = 2; }
-    else if (!(u & 0x10))      { len = 3; }
-    else if (!(u & 0x08))      { len = 4; }
-    else if (!(u & 0x04))      { len = 5; }
-    else if (!(u & 0x02))      { len = 6; }
-    else if (!(u & 0x01))      { len = 7; }
-    else                       { len = 13; } /* whoa! */
+    len = UTF8SKIP(s);
 
     slen = len - 1;
     s++;
@@ -143,7 +137,7 @@ string, false otherwise.
 =cut
 */
 
-bool 
+bool
 Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len)
 {
     U8* x=s;
@@ -159,7 +153,7 @@ Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len)
 }
 
 /*
-=for apidoc Am|U8* s|utf8_to_uv|I32 *retlen|I32 checking
+=for apidoc Am|U8* s|utf8_to_uv_chk|I32 *retlen|I32 checking
 
 Returns the character value of the first character in the string C<s>
 which is assumed to be in UTF8 encoding; C<retlen> will be set to the
@@ -176,7 +170,7 @@ warning is produced.
 */
 
 UV
-Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
+Perl_utf8_to_uv_chk(pTHX_ U8* s, I32* retlen, bool checking)
 {
     UV uv = *s;
     int len;
@@ -192,7 +186,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
            return 0;
        }
 
-       if (ckWARN_d(WARN_UTF8))     
+       if (ckWARN_d(WARN_UTF8))
            Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
        if (retlen)
            *retlen = 1;
@@ -219,7 +213,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
                return 0;
             }
 
-           if (ckWARN_d(WARN_UTF8))     
+           if (ckWARN_d(WARN_UTF8))
                Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
            if (retlen)
                *retlen -= len + 1;
@@ -231,6 +225,26 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
     return uv;
 }
 
+/*
+=for apidoc Am|U8* s|utf8_to_uv|I32 *retlen
+
+Returns the character value of the first character in the string C<s>
+which is assumed to be in UTF8 encoding; C<retlen> will be set to the
+length, in bytes, of that character, and the pointer C<s> will be
+advanced to the end of the character.
+
+If C<s> does not point to a well-formed UTF8 character, an optional UTF8
+warning is produced.
+
+=cut
+*/
+
+UV
+Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen)
+{
+ return Perl_utf8_to_uv_chk(aTHX_ s, retlen, 0);
+}
+
 /* utf8_distance(a,b) returns the number of UTF8 characters between
    the pointers a and b                                                        */
 
@@ -302,7 +316,7 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
         if (c >= 0x80 &&
            ( (s >= send) || ((*s++ & 0xc0) != 0x80) || ((c & 0xfe) != 0xc2))) {
            *len = -1;
-           return 0;    
+           return 0;
        }
     }
     s = save;
@@ -311,7 +325,7 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
             *d++ = *s++;
         else {
             I32 ulen;
-            *d++ = (U8)utf8_to_uv(s, &ulen, 0);
+            *d++ = (U8)utf8_to_uv(s, &ulen);
             s += ulen;
         }
     }
@@ -839,7 +853,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,0,0);
+    return uv ? uv : utf8_to_uv_chk(p,0,0);
 }
 
 UV
@@ -850,7 +864,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,0,0);
+    return uv ? uv : utf8_to_uv_chk(p,0,0);
 }
 
 UV
@@ -861,7 +875,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,0,0);
+    return uv ? uv : utf8_to_uv_chk(p,0,0);
 }
 
 /* a "swash" is a swatch hash */
@@ -871,7 +885,7 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
 {
     SV* retval;
     char tmpbuf[256];
-    dSP;    
+    dSP;
 
     if (!gv_stashpv(pkg, 0)) { /* demand load utf8 */
        ENTER;
@@ -895,7 +909,7 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     if (PL_curcop == &PL_compiling)    /* XXX ought to be handled by lex_start */
        strncpy(tmpbuf, PL_tokenbuf, sizeof tmpbuf);
     if (call_method("SWASHNEW", G_SCALAR))
-       retval = newSVsv(*PL_stack_sp--);    
+       retval = newSVsv(*PL_stack_sp--);
     else
        retval = &PL_sv_undef;
     LEAVE;
@@ -951,11 +965,11 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr)
            PUSHMARK(SP);
            EXTEND(SP,3);
            PUSHs((SV*)sv);
-           PUSHs(sv_2mortal(newSViv(utf8_to_uv(ptr, 0, 0) & ~(needents - 1))));
+           PUSHs(sv_2mortal(newSViv(utf8_to_uv_chk(ptr, 0, 0) & ~(needents - 1))));
            PUSHs(sv_2mortal(newSViv(needents)));
            PUTBACK;
            if (call_method("SWASHGET", G_SCALAR))
-               retval = newSVsv(*PL_stack_sp--);    
+               retval = newSVsv(*PL_stack_sp--);
            else
                retval = &PL_sv_undef;
            POPSTACK;