Detypo.
[p5sagit/p5-mst-13.2.git] / utf8.c
diff --git a/utf8.c b/utf8.c
index d7b0784..75226ca 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -50,7 +50,7 @@ Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
        *d++ = UTF_TO_NATIVE(uv);
        return d;
     }
-#if defined(EBCDIC) || 1 /* always for testing */
+#if defined(EBCDIC)
     else {
        STRLEN len  = UNISKIP(uv);
        U8 *p = d+len-1;
@@ -400,6 +400,7 @@ malformed:
        case UTF8_WARN_SHORT:
            Perl_sv_catpvf(aTHX_ sv, "(%d byte%s, need %d)",
                            curlen, curlen == 1 ? "" : "s", expectlen);
+           expectlen = curlen;         /* distance for caller to skip */
            break;
        case UTF8_WARN_OVERFLOW:
            Perl_sv_catpvf(aTHX_ sv, "(overflow at 0x%"UVxf", byte 0x%02x)",
@@ -796,7 +797,7 @@ Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
 /* for now these are all defined (inefficiently) in terms of the utf8 versions */
 
 bool
-Perl_is_uni_alnum(pTHX_ U32 c)
+Perl_is_uni_alnum(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -804,7 +805,7 @@ Perl_is_uni_alnum(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_alnumc(pTHX_ U32 c)
+Perl_is_uni_alnumc(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -812,7 +813,7 @@ Perl_is_uni_alnumc(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_idfirst(pTHX_ U32 c)
+Perl_is_uni_idfirst(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -820,7 +821,7 @@ Perl_is_uni_idfirst(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_alpha(pTHX_ U32 c)
+Perl_is_uni_alpha(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -828,7 +829,7 @@ Perl_is_uni_alpha(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_ascii(pTHX_ U32 c)
+Perl_is_uni_ascii(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -836,7 +837,7 @@ Perl_is_uni_ascii(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_space(pTHX_ U32 c)
+Perl_is_uni_space(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -844,7 +845,7 @@ Perl_is_uni_space(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_digit(pTHX_ U32 c)
+Perl_is_uni_digit(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -852,7 +853,7 @@ Perl_is_uni_digit(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_upper(pTHX_ U32 c)
+Perl_is_uni_upper(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -860,7 +861,7 @@ Perl_is_uni_upper(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_lower(pTHX_ U32 c)
+Perl_is_uni_lower(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -868,7 +869,7 @@ Perl_is_uni_lower(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_cntrl(pTHX_ U32 c)
+Perl_is_uni_cntrl(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -876,7 +877,7 @@ Perl_is_uni_cntrl(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_graph(pTHX_ U32 c)
+Perl_is_uni_graph(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -884,7 +885,7 @@ Perl_is_uni_graph(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_print(pTHX_ U32 c)
+Perl_is_uni_print(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -892,7 +893,7 @@ Perl_is_uni_print(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_punct(pTHX_ U32 c)
+Perl_is_uni_punct(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXLEN+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
@@ -900,119 +901,127 @@ Perl_is_uni_punct(pTHX_ U32 c)
 }
 
 bool
-Perl_is_uni_xdigit(pTHX_ U32 c)
+Perl_is_uni_xdigit(pTHX_ UV c)
 {
-    U8 tmpbuf[UTF8_MAXLEN*2+1];
+    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
     return is_utf8_xdigit(tmpbuf);
 }
 
-U32
-Perl_to_uni_upper(pTHX_ U32 c, U8* p, STRLEN *lenp)
+UV
+Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN*2+1];
+    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
     return to_utf8_upper(tmpbuf, p, lenp);
 }
 
-U32
-Perl_to_uni_title(pTHX_ U32 c, U8* p, STRLEN *lenp)
+UV
+Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN*2+1];
+    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
     return to_utf8_title(tmpbuf, p, lenp);
 }
 
-U32
-Perl_to_uni_lower(pTHX_ U32 c, U8* p, STRLEN *lenp)
+UV
+Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
-    U8 tmpbuf[UTF8_MAXLEN+1];
+    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
     uvchr_to_utf8(tmpbuf, (UV)c);
     return to_utf8_lower(tmpbuf, p, lenp);
 }
 
+UV
+Perl_to_uni_fold(pTHX_ UV c, U8* p, STRLEN *lenp)
+{
+    U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
+    uvchr_to_utf8(tmpbuf, (UV)c);
+    return to_utf8_fold(tmpbuf, p, lenp);
+}
+
 /* for now these all assume no locale info available for Unicode > 255 */
 
 bool
-Perl_is_uni_alnum_lc(pTHX_ U32 c)
+Perl_is_uni_alnum_lc(pTHX_ UV c)
 {
     return is_uni_alnum(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_alnumc_lc(pTHX_ U32 c)
+Perl_is_uni_alnumc_lc(pTHX_ UV c)
 {
     return is_uni_alnumc(c);   /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_idfirst_lc(pTHX_ U32 c)
+Perl_is_uni_idfirst_lc(pTHX_ UV c)
 {
     return is_uni_idfirst(c);  /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_alpha_lc(pTHX_ U32 c)
+Perl_is_uni_alpha_lc(pTHX_ UV c)
 {
     return is_uni_alpha(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_ascii_lc(pTHX_ U32 c)
+Perl_is_uni_ascii_lc(pTHX_ UV c)
 {
     return is_uni_ascii(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_space_lc(pTHX_ U32 c)
+Perl_is_uni_space_lc(pTHX_ UV c)
 {
     return is_uni_space(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_digit_lc(pTHX_ U32 c)
+Perl_is_uni_digit_lc(pTHX_ UV c)
 {
     return is_uni_digit(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_upper_lc(pTHX_ U32 c)
+Perl_is_uni_upper_lc(pTHX_ UV c)
 {
     return is_uni_upper(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_lower_lc(pTHX_ U32 c)
+Perl_is_uni_lower_lc(pTHX_ UV c)
 {
     return is_uni_lower(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_cntrl_lc(pTHX_ U32 c)
+Perl_is_uni_cntrl_lc(pTHX_ UV c)
 {
     return is_uni_cntrl(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_graph_lc(pTHX_ U32 c)
+Perl_is_uni_graph_lc(pTHX_ UV c)
 {
     return is_uni_graph(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_print_lc(pTHX_ U32 c)
+Perl_is_uni_print_lc(pTHX_ UV c)
 {
     return is_uni_print(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_punct_lc(pTHX_ U32 c)
+Perl_is_uni_punct_lc(pTHX_ UV c)
 {
     return is_uni_punct(c);    /* XXX no locale support yet */
 }
 
 bool
-Perl_is_uni_xdigit_lc(pTHX_ U32 c)
+Perl_is_uni_xdigit_lc(pTHX_ UV c)
 {
     return is_uni_xdigit(c);   /* XXX no locale support yet */
 }
@@ -1220,8 +1229,6 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
         HE *he;
 
         uv = utf8_to_uvchr(p, 0);
-        if (uv <= 0xff)
-            uv = NATIVE_TO_UTF(uv);
 
         if ((hv    = get_hv(special, FALSE)) &&
             (keysv = sv_2mortal(Perl_newSVpvf(aTHX_ "%04"UVXf, uv))) &&
@@ -1232,7 +1239,6 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
              if (*lenp > 1 || UNI_IS_INVARIANT(c))
                   Copy(s, ustrp, *lenp, U8);
              else {
-                  c = UTF_TO_NATIVE(c);
                   /* something in the 0x80..0xFF range */
                   ustrp[0] = UTF8_EIGHT_BIT_HI(c);
                   ustrp[1] = UTF8_EIGHT_BIT_LO(c);
@@ -1241,7 +1247,8 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
              return 0;
         }
     }
-    *lenp = UNISKIP(uv);
+    if (lenp)
+       *lenp = UNISKIP(uv);
     uvuni_to_utf8(ustrp, uv);
     return uv;
 }
@@ -1518,6 +1525,16 @@ Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
     return UNI_TO_NATIVE(uv);
 }
 
+/*
+=for apidoc A|char *|pv_uni_display|SV *dsv|U8 *spv|STRLEN len|STRLEN pvlim|UV flags
+
+Build to the scalar dsv a displayable version of the string spv,
+length len, the displayable version being at most pvlim bytes long
+(if longer, the rest is truncated and "..." will be appended).
+The flags argument is currently unused but available for future extensions.
+The pointer to the PV of the dsv is returned.
+
+=cut */
 char *
 Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
 {
@@ -1540,6 +1557,16 @@ Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
     return SvPVX(dsv);
 }
 
+/*
+=for apidoc A|char *|sv_uni_display|SV *dsv|SV *ssv|STRLEN pvlim|UV flags
+
+Build to the scalar dsv a displayable version of the scalar sv,
+he displayable version being at most pvlim bytes long
+(if longer, the rest is truncated and "..." will be appended).
+The flags argument is currently unused but available for future extensions.
+The pointer to the PV of the dsv is returned.
+
+=cut */
 char *
 Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
 {
@@ -1547,47 +1574,66 @@ Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
                                pvlim, flags);
 }
 
+/*
+=for apidoc A|I32|ibcmp_utf8|const char *s1|bool u1|const char *s2|bool u2|register I32 len
+
+Return true if the strings s1 and s2 differ case-insensitively, false
+if not (if they are equal case-insensitively).  If u1 is true, the
+string s1 is assumed to be in UTF-8-encoded Unicode.  If u2 is true,
+the string s2 is assumed to be in UTF-8-encoded Unicode.
+
+For case-insensitiveness, the "casefolding" of Unicode is used
+instead of upper/lowercasing both the characters, see
+http://www.unicode.org/unicode/reports/tr21/ (Case Mappings).
+
+=cut */
 I32
-Perl_ibcmp_utf8(pTHX_ const char *s1, bool u1, const char *s2, bool u2, register I32 len)
+Perl_ibcmp_utf8(pTHX_ const char *s1, bool u1, register I32 len1, const char *s2, bool u2, register I32 len2)
 {
-     register U8 *a = (U8*)s1;
-     register U8 *b = (U8*)s2;
+     register U8 *a  = (U8*)s1;
+     register U8 *b  = (U8*)s2;
+     register U8 *ae = b + len1;
+     register U8 *be = b + len2;
      STRLEN la, lb;
      UV ca, cb;
      STRLEN ulen1, ulen2;
-     U8 tmpbuf1[UTF8_MAXLEN*3+1];
-     U8 tmpbuf2[UTF8_MAXLEN*3+1];
-
-     while (len) {
-         if (u1)
+     U8 tmpbuf1[UTF8_MAXLEN_FOLD+1];
+     U8 tmpbuf2[UTF8_MAXLEN_FOLD+1];
+     
+     while (a < ae && b < be) {
+         if (u1) {
+              if (a + UTF8SKIP(a) > ae)
+                   break;
               ca = utf8_to_uvchr((U8*)a, &la);
-         else {
+         } else {
               ca = *a;
               la = 1;
          }
-         if (u2)
+         if (u2) {
+              if (b + UTF8SKIP(b) > be)
+                   break;
               cb = utf8_to_uvchr((U8*)b, &lb);
-         else {
+         } else {
               cb = *b;
               lb = 1;
          }
          if (ca != cb) {
               if (u1)
-                   to_uni_lower(NATIVE_TO_UNI(ca), tmpbuf1, &ulen1);
+                   to_uni_fold(NATIVE_TO_UNI(ca), tmpbuf1, &ulen1);
               else
                    ulen1 = 1;
               if (u2)
-                   to_uni_lower(NATIVE_TO_UNI(cb), tmpbuf2, &ulen2);
+                   to_uni_fold(NATIVE_TO_UNI(cb), tmpbuf2, &ulen2);
               else
                    ulen2 = 1;
               if (ulen1 != ulen2
                   || (ulen1 == 1 && PL_fold[ca] != PL_fold[cb])
-                  || memNE(tmpbuf1, tmpbuf2, ulen1))
-                   return 1;
+                  || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
+                   return 1; /* mismatch */
          }
          a += la;
          b += lb;
-    }
-    return 0;
+     }
+     return a == ae && b == be ? 0 : 1; /* 0 match, 1 mismatch */
 }