Improvements and fixes to the _ prototype

[perl5.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index f3b7a3b..19f54ca 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -25,6 +25,13 @@
 #define PERL_IN_UTF8_C
 #include "perl.h"
 
+#ifndef EBCDIC
+/* Separate prototypes needed because in ASCII systems these
+ * usually macros but they still are compiled as code, too. */
+PERL_CALLCONV UV       Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags);
+PERL_CALLCONV U8*      Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv);
+#endif
+
 static const char unees[] =
     "Malformed UTF-8 character (unexpected end of string)";
 
@@ -262,13 +269,10 @@ See also is_utf8_string_loclen() and is_utf8_string_loc().
 bool
 Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len)
 {
+    const U8* const send = s + (len ? len : strlen((const char *)s));
     const U8* x = s;
-    const U8* send;
 
     PERL_UNUSED_CONTEXT;
-    if (!len)
-       len = strlen((const char *)s);
-    send = s + len;
 
     while (x < send) {
        STRLEN c;
@@ -283,9 +287,10 @@ Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len)
             c = UTF8SKIP(x);
             if (IS_UTF8_CHAR_FAST(c)) {
                 if (!IS_UTF8_CHAR(x, c))
-                    goto out;
-            } else if (!is_utf8_char_slow(x, c))
-                goto out;
+                    c = 0;
+            }
+            else
+               c = is_utf8_char_slow(x, c);
 #else
             c = is_utf8_char(x);
 #endif /* #ifdef IS_UTF8_CHAR */
@@ -328,17 +333,12 @@ See also is_utf8_string_loc() and is_utf8_string().
 bool
 Perl_is_utf8_string_loclen(pTHX_ const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
 {
+    const U8* const send = s + (len ? len : strlen((const char *)s));
     const U8* x = s;
-    const U8* send;
     STRLEN c;
+    STRLEN outlen = 0;
     PERL_UNUSED_CONTEXT;
 
-    if (!len)
-        len = strlen((const char *)s);
-    send = s + len;
-    if (el)
-        *el = 0;
-
     while (x < send) {
         /* Inline the easy bits of is_utf8_char() here for speed... */
         if (UTF8_IS_INVARIANT(*x))
@@ -361,17 +361,16 @@ Perl_is_utf8_string_loclen(pTHX_ const U8 *s, STRLEN len, const U8 **ep, STRLEN
                 goto out;
         }
          x += c;
-        if (el)
-            (*el)++;
+        outlen++;
     }
 
  out:
+    if (el)
+        *el = outlen;
+
     if (ep)
         *ep = x;
-    if (x != send)
-       return FALSE;
-
-    return TRUE;
+    return (x == send);
 }
 
 /*
@@ -532,7 +531,7 @@ malformed:
 
     if (flags & UTF8_CHECK_ONLY) {
        if (retlen)
-           *retlen = -1;
+           *retlen = ((STRLEN) -1);
        return 0;
     }
 
@@ -661,6 +660,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
 {
     dVAR;
     STRLEN len = 0;
+    U8 t = 0;
 
     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g.
      * the bitops (especially ~) can create illegal UTF-8.
@@ -669,7 +669,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
     if (e < s)
        goto warn_and_return;
     while (s < e) {
-       const U8 t = UTF8SKIP(s);
+       t = UTF8SKIP(s);
        if (e - s < t) {
            warn_and_return:
            if (ckWARN_d(WARN_UTF8)) {
@@ -749,6 +749,8 @@ Unlike C<bytes_to_utf8>, this over-writes the original string, and
 updates len to contain the new length.
 Returns zero on failure, setting C<len> to -1.
 
+If you need a copy of the string, see C<bytes_from_utf8>.
+
 =cut
 */
 
@@ -766,7 +768,7 @@ Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len)
         if (!UTF8_IS_INVARIANT(c) &&
             (!UTF8_IS_DOWNGRADEABLE_START(c) || (s >= send)
             || !(c = *s++) || !UTF8_IS_CONTINUATION(c))) {
-            *len = -1;
+            *len = ((STRLEN) -1);
             return 0;
         }
     }
@@ -819,7 +821,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
        }
     }
 
-    *is_utf8 = 0;              
+    *is_utf8 = FALSE;
 
     Newx(d, (*len) - count + 1, U8);
     s = start; start = d;
@@ -894,7 +896,7 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
     }
 
     if (bytelen & 1)
-       Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %"UVf, (UV)bytelen);
+       Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %"UVuf, (UV)bytelen);
 
     pend = p + bytelen;
 
@@ -902,7 +904,11 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
        UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */
        p += 2;
        if (uv < 0x80) {
+#ifdef EBCDIC
+           *d++ = UNI_TO_NATIVE(uv);
+#else
            *d++ = (U8)uv;
+#endif
            continue;
        }
        if (uv < 0x800) {
@@ -1388,10 +1394,10 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
     if (special && (uv1 == 0xDF || uv1 > 0xFF)) {
          /* It might be "special" (sometimes, but not always,
          * a multicharacter mapping) */
-        HV *hv;
+        HV * const hv = get_hv(special, FALSE);
         SV **svp;
 
-        if ((hv  = get_hv(special, FALSE)) &&
+        if (hv &&
             (svp = hv_fetch(hv, (const char*)tmpbuf, UNISKIP(uv1), FALSE)) &&
             (*svp)) {
             const char *s;
@@ -1614,7 +1620,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
         if (SvPOK(retval))
            Perl_croak(aTHX_ "Can't find Unicode property definition \"%"SVf"\"",
-                      retval);
+                      (void*)retval);
        Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");
     }
     return retval;
@@ -1647,7 +1653,7 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
     U32 bit;
     SV *swatch;
     U8 tmputf8[2];
-    UV c = NATIVE_TO_ASCII(*ptr);
+    const UV c = NATIVE_TO_ASCII(*ptr);
 
     if (!do_utf8 && !UNI_IS_INVARIANT(c)) {
        tmputf8[0] = (U8)UTF8_EIGHT_BIT_HI(c);
@@ -1743,6 +1749,7 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
        return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ;
     }
     Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width");
+    NORETURN_FUNCTION_END;
 }
 
 /* Note:
@@ -1809,7 +1816,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
     l = (U8*)SvPV(*listsvp, lcur);
     lend = l + lcur;
     while (l < lend) {
-       UV min, max, val, key;
+       UV min, max, val;
        STRLEN numlen;
        I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX;
 
@@ -1882,6 +1889,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
            continue;
 
        if (octets) {
+           UV key;
            if (min < start) {
                if (!none || val < none) {
                    val += start - min;
@@ -1912,6 +1920,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
            }
        }
        else { /* bits == 1, then val should be ignored */
+           UV key;
            if (min < start)
                min = start;
            for (key = min; key <= max; key++) {
@@ -1937,7 +1946,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
        U8 *s, *o, *nl;
        STRLEN slen, olen;
 
-       U8 opc = *x++;
+       const U8 opc = *x++;
        if (opc == '\n')
            continue;
 
@@ -2007,7 +2016,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
        else {
            STRLEN otheroctets = otherbits >> 3;
            STRLEN offset = 0;
-           U8* send = s + slen;
+           U8* const send = s + slen;
 
            while (s < send) {
                UV otherval = 0;
@@ -2026,7 +2035,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
                }
 
                if (opc == '+' && otherval)
-                   /*EMPTY*/;   /* replace with otherval */
+                   NOOP;   /* replace with otherval */
                else if (opc == '!' && !otherval)
                    otherval = 1;
                else if (opc == '-' && otherval)