This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Inline foldEQ, foldEQ_latin1, foldEQ_locale
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index b198b47..62316fc 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -150,7 +150,7 @@ PP(pp_padhv)
             && block_gimme() == G_VOID  ))
          && (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))
     )
-       SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
+       SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : &PL_sv_no);
     else if (gimme == G_SCALAR) {
        SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
        SETs(sv);
@@ -3626,7 +3626,7 @@ PP(pp_ord)
     const U8 *s = (U8*)SvPV_const(argsv, len);
 
     SETu(DO_UTF8(argsv)
-           ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV)
+           ? (len ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV) : 0)
            : (UV)(*s));
 
     return NORMAL;
@@ -3790,16 +3790,16 @@ PP(pp_ucfirst)
         ulen = UTF8SKIP(s);
         if (op_type == OP_UCFIRST) {
 #ifdef USE_LOCALE_CTYPE
-           _to_utf8_title_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+           _toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-           _to_utf8_title_flags(s, tmpbuf, &tculen, 0);
+           _toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, 0);
 #endif
        }
         else {
 #ifdef USE_LOCALE_CTYPE
-           _to_utf8_lower_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+           _toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-           _to_utf8_lower_flags(s, tmpbuf, &tculen, 0);
+           _toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, 0);
 #endif
        }
 
@@ -4090,9 +4090,9 @@ PP(pp_uc)
 
             u = UTF8SKIP(s);
 #ifdef USE_LOCALE_CTYPE
-            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+            uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, 0);
+            uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, 0);
 #endif
 #define GREEK_CAPITAL_LETTER_IOTA 0x0399
 #define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
@@ -4306,9 +4306,9 @@ PP(pp_lc)
            STRLEN ulen;
 
 #ifdef USE_LOCALE_CTYPE
-           _to_utf8_lower_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+           _toLOWER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-           _to_utf8_lower_flags(s, tmpbuf, &ulen, 0);
+           _toLOWER_utf8_flags(s, send, tmpbuf, &ulen, 0);
 #endif
 
            /* Here is where we would do context-sensitive actions.  See the
@@ -4404,7 +4404,7 @@ PP(pp_quotemeta)
                        to_quote = TRUE;
                    }
                }
-               else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
+               else if (UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, s + len)) {
                    if (
 #ifdef USE_LOCALE_CTYPE
                    /* In locale, we quote all non-ASCII Latin1 chars.
@@ -4516,7 +4516,7 @@ PP(pp_fc)
             const STRLEN u = UTF8SKIP(s);
             STRLEN ulen;
 
-            _to_utf8_fold_flags(s, tmpbuf, &ulen, flags);
+            _toFOLD_utf8_flags(s, send, tmpbuf, &ulen, flags);
 
             if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
                 const UV o = d - (U8*)SvPVX_const(dest);
@@ -5652,8 +5652,6 @@ PP(pp_reverse)
     }
     else {
        char *up;
-       char *down;
-       I32 tmp;
        dTARGET;
        STRLEN len;
 
@@ -5666,6 +5664,7 @@ PP(pp_reverse)
 
        up = SvPV_force(TARG, len);
        if (len > 1) {
+            char *down;
            if (DO_UTF8(TARG)) {        /* first reverse each character */
                U8* s = (U8*)SvPVX(TARG);
                const U8* send = (U8*)(s + len);
@@ -5682,9 +5681,9 @@ PP(pp_reverse)
                        down = (char*)(s - 1);
                        /* reverse this character */
                        while (down > up) {
-                           tmp = *up;
+                            const char tmp = *up;
                            *up++ = *down;
-                           *down-- = (char)tmp;
+                            *down-- = tmp;
                        }
                    }
                }
@@ -5692,9 +5691,9 @@ PP(pp_reverse)
            }
            down = SvPVX(TARG) + len - 1;
            while (down > up) {
-               tmp = *up;
+                const char tmp = *up;
                *up++ = *down;
-               *down-- = (char)tmp;
+                *down-- = tmp;
            }
            (void)SvPOK_only_UTF8(TARG);
        }
@@ -5794,15 +5793,15 @@ PP(pp_split)
     orig = s;
     if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
        if (do_utf8) {
-           while (isSPACE_utf8(s))
+           while (s < strend && isSPACE_utf8_safe(s, strend))
                s += UTF8SKIP(s);
        }
        else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
-           while (isSPACE_LC(*s))
+           while (s < strend && isSPACE_LC(*s))
                s++;
        }
        else {
-           while (isSPACE(*s))
+           while (s < strend && isSPACE(*s))
                s++;
        }
     }
@@ -5819,9 +5818,9 @@ PP(pp_split)
            m = s;
            /* this one uses 'm' and is a negative test */
            if (do_utf8) {
-               while (m < strend && ! isSPACE_utf8(m) ) {
+               while (m < strend && ! isSPACE_utf8_safe(m, strend) ) {
                    const int t = UTF8SKIP(m);
-                   /* isSPACE_utf8 returns FALSE for malform utf8 */
+                   /* isSPACE_utf8_safe returns FALSE for malform utf8 */
                    if (strend - m < t)
                        m = strend;
                    else
@@ -5859,7 +5858,7 @@ PP(pp_split)
 
            /* this one uses 's' and is a positive test */
            if (do_utf8) {
-               while (s < strend && isSPACE_utf8(s) )
+               while (s < strend && isSPACE_utf8_safe(s, strend) )
                    s +=  UTF8SKIP(s);
            }
            else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
@@ -6142,7 +6141,7 @@ PP(pp_split)
     }
 
     GETTARGET;
-    PUSHi(iters);
+    XPUSHi(iters);
     RETURN;
 }
 
@@ -6801,6 +6800,26 @@ PP(pp_argdefelem)
 }
 
 
+static SV *
+S_find_runcv_name(void)
+{
+    dTHX;
+    CV *cv;
+    GV *gv;
+    SV *sv;
+
+    cv = find_runcv(0);
+    if (!cv)
+        return &PL_sv_no;
+
+    gv = CvGV(cv);
+    if (!gv)
+        return &PL_sv_no;
+
+    sv = sv_2mortal(newSV(0));
+    gv_fullname4(sv, gv, NULL, TRUE);
+    return sv;
+}
 
 /* Check a  a subs arguments - i.e. that it has the correct number of args
  * (and anything else we might think of in future). Typically used with
@@ -6823,14 +6842,15 @@ PP(pp_argcheck)
     too_few = (argc < (params - opt_params));
 
     if (UNLIKELY(too_few || (!slurpy && argc > params)))
-        /* diag_listed_as: Too few arguments for subroutine */
-        /* diag_listed_as: Too many arguments for subroutine */
-        Perl_croak_caller("Too %s arguments for subroutine",
-                            too_few ? "few" : "many");
+        /* diag_listed_as: Too few arguments for subroutine '%s' */
+        /* diag_listed_as: Too many arguments for subroutine '%s' */
+        Perl_croak_caller("Too %s arguments for subroutine '%" SVf "'",
+                          too_few ? "few" : "many", S_find_runcv_name());
 
     if (UNLIKELY(slurpy == '%' && argc > params && (argc - params) % 2))
-        Perl_croak_caller("Odd name/value argument for subroutine");
-
+        /* diag_listed_as: Odd name/value argument for subroutine '%s' */
+        Perl_croak_caller("Odd name/value argument for subroutine '%" SVf "'",
+                          S_find_runcv_name());
 
     return NORMAL;
 }