disallow eval { goto &foo }

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

diff --git a/utf8.c b/utf8.c
index bb31862..35fbe38 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -25,7 +25,8 @@
 #define PERL_IN_UTF8_C
 #include "perl.h"
 
-static char unees[] = "Malformed UTF-8 character (unexpected end of string)";
+static const char unees[] =
+    "Malformed UTF-8 character (unexpected end of string)";
 
 /* 
 =head1 Unicode Support
@@ -237,13 +238,13 @@ Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len)
 {
     const U8* x = s;
     const U8* send;
-    STRLEN c;
 
     if (!len && s)
        len = strlen((const char *)s);
     send = s + len;
 
     while (x < send) {
+       STRLEN c;
         /* Inline the easy bits of is_utf8_char() here for speed... */
         if (UTF8_IS_INVARIANT(*x))
              c = 1;
@@ -599,24 +600,16 @@ Perl_utf8_length(pTHX_ const U8 *s, const 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) {
-        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;
-    }
+    if (e < s)
+       goto warn_and_return;
     while (s < e) {
-       U8 t = UTF8SKIP(s);
-
+       const U8 t = UTF8SKIP(s);
        if (e - s < t) {
+           warn_and_return:
            if (ckWARN_d(WARN_UTF8)) {
                if (PL_op)
                    Perl_warner(aTHX_ packWARN(WARN_UTF8),
-                               unees, OP_DESC(PL_op));
+                           "%s in %s", unees, OP_DESC(PL_op));
                else
                    Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
            }
@@ -653,26 +646,18 @@ Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b)
     if (a < b) {
        while (a < b) {
            const U8 c = UTF8SKIP(a);
-
-           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;
-           }
+           if (b - a < c)
+               goto warn_and_return;
            a += c;
            off--;
        }
     }
     else {
        while (b < a) {
-           U8 c = UTF8SKIP(b);
+           const U8 c = UTF8SKIP(b);
 
            if (a - b < c) {
+               warn_and_return:
                if (ckWARN_d(WARN_UTF8)) {
                    if (PL_op)
                        Perl_warner(aTHX_ packWARN(WARN_UTF8),
@@ -704,7 +689,7 @@ on the first byte of character or just after the last byte of a character.
 */
 
 U8 *
-Perl_utf8_hop(pTHX_ U8 *s, I32 off)
+Perl_utf8_hop(pTHX_ const U8 *s, I32 off)
 {
     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
      * the bitops (especially ~) can create illegal UTF-8.
@@ -721,7 +706,7 @@ Perl_utf8_hop(pTHX_ U8 *s, I32 off)
                s--;
        }
     }
-    return s;
+    return (U8 *)s;
 }
 
 /*
@@ -787,7 +772,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
     I32 count = 0;
 
     if (!*is_utf8)
-       return start;
+        return (U8 *)start;
 
     /* ensure valid UTF-8 and chars < 256 before converting string */
     for (send = s + *len; s < send;) {
@@ -797,7 +782,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
                 (c = *s++) && UTF8_IS_CONTINUATION(c))
                count++;
            else
-               return start;
+                return (U8 *)start;
        }
     }
 
@@ -816,7 +801,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
     }
     *d = '\0';
     *len = d - start;
-    return start;
+    return (U8 *)start;
 }
 
 /*
@@ -1399,7 +1384,6 @@ The "normal" is a string like "ToLower" which means the swash
 UV
 Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const char *normal, const char *special)
 {
-    UV uv1;
     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
     STRLEN len = 0;
 
@@ -1407,7 +1391,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const
     /* The NATIVE_TO_UNI() and UNI_TO_NATIVE() mappings
      * are necessary in EBCDIC, they are redundant no-ops
      * in ASCII-ish platforms, and hopefully optimized away. */
-    uv1 = NATIVE_TO_UNI(uv0);
+    const UV uv1 = NATIVE_TO_UNI(uv0);
     uvuni_to_utf8(tmpbuf, uv1);
 
     if (!*swashp) /* load on-demand */
@@ -1570,6 +1554,7 @@ Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
 SV*
 Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none)
 {
+    dVAR;
     SV* retval;
     SV* tokenbufsv = sv_newmortal();
     dSP;
@@ -1578,6 +1563,11 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     HV *stash = gv_stashpvn(pkg, pkg_len, FALSE);
     SV* errsv_save;
 
+    PUSHSTACKi(PERLSI_MAGIC);
+    ENTER;
+    SAVEI32(PL_hints);
+    PL_hints = 0;
+    save_re_context();
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {     /* demand load utf8 */
        ENTER;
        errsv_save = newSVsv(ERRSV);
@@ -1589,7 +1579,6 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
        LEAVE;
     }
     SPAGAIN;
-    PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
     EXTEND(SP,5);
     PUSHs(sv_2mortal(newSVpvn(pkg, pkg_len)));
@@ -1598,10 +1587,6 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     PUSHs(sv_2mortal(newSViv(minbits)));
     PUSHs(sv_2mortal(newSViv(none)));
     PUTBACK;
-    ENTER;
-    SAVEI32(PL_hints);
-    PL_hints = 0;
-    save_re_context();
     if (IN_PERL_COMPILETIME) {
        /* XXX ought to be handled by lex_start */
        SAVEI32(PL_in_my);
@@ -1620,7 +1605,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     POPSTACK;
     if (IN_PERL_COMPILETIME) {
        STRLEN len;
-       char* pv = SvPV(tokenbufsv, len);
+        const char* pv = SvPV(tokenbufsv, len);
 
        Copy(pv, PL_tokenbuf, len+1, char);
        PL_curcop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
@@ -1643,6 +1628,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
 UV
 Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
 {
+    dVAR;
     HV* hv = (HV*)SvRV(sv);
     U32 klen;
     U32 off;
@@ -1693,7 +1679,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
 
     if (hv   == PL_last_swash_hv &&
        klen == PL_last_swash_klen &&
-       (!klen || memEQ(ptr, PL_last_swash_key, klen)) )
+       (!klen || memEQ((char *)ptr, (char *)PL_last_swash_key, klen)) )
     {
        tmps = PL_last_swash_tmps;
        slen = PL_last_swash_slen;
@@ -1863,7 +1849,7 @@ Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, UV f
         }
         u = utf8_to_uvchr((U8*)s, 0);
         if (u < 256) {
-            unsigned char c = u & 0xFF;
+            const unsigned char c = (unsigned char)u & 0xFF;
             if (!ok && (flags & UNI_DISPLAY_BACKSLASH)) {
                 switch (c) {
                 case '\n':
@@ -2035,5 +2021,5 @@ Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const
  * indent-tabs-mode: t
  * End:
  *
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */