This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: Refactor part of tr// handling, mostly for EBCDIC
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 837b67b..657abf7 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);
@@ -492,7 +492,7 @@ PP(pp_prototype)
        if (strnEQ(s, "CORE::", 6)) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
            if (!code)
-               DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"",
+               DIE(aTHX_ "Can't find an opnumber for \"%" UTF8f "\"",
                   UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6));
            {
                SV * const sv = core_prototype(NULL, s + 6, code, NULL);
@@ -658,10 +658,9 @@ PP(pp_gelem)
     sv = NULL;
     if (elem) {
        /* elem will always be NUL terminated.  */
-       const char * const second_letter = elem + 1;
        switch (*elem) {
        case 'A':
-           if (len == 5 && strEQ(second_letter, "RRAY"))
+           if (memEQs(elem, len, "ARRAY"))
            {
                tmpRef = MUTABLE_SV(GvAV(gv));
                if (tmpRef && !AvREAL((const AV *)tmpRef)
@@ -670,42 +669,42 @@ PP(pp_gelem)
            }
            break;
        case 'C':
-           if (len == 4 && strEQ(second_letter, "ODE"))
+           if (memEQs(elem, len, "CODE"))
                tmpRef = MUTABLE_SV(GvCVu(gv));
            break;
        case 'F':
-           if (len == 10 && strEQ(second_letter, "ILEHANDLE")) {
+           if (memEQs(elem, len, "FILEHANDLE")) {
                tmpRef = MUTABLE_SV(GvIOp(gv));
            }
            else
-               if (len == 6 && strEQ(second_letter, "ORMAT"))
+               if (memEQs(elem, len, "FORMAT"))
                    tmpRef = MUTABLE_SV(GvFORM(gv));
            break;
        case 'G':
-           if (len == 4 && strEQ(second_letter, "LOB"))
+           if (memEQs(elem, len, "GLOB"))
                tmpRef = MUTABLE_SV(gv);
            break;
        case 'H':
-           if (len == 4 && strEQ(second_letter, "ASH"))
+           if (memEQs(elem, len, "HASH"))
                tmpRef = MUTABLE_SV(GvHV(gv));
            break;
        case 'I':
-           if (*second_letter == 'O' && !elem[2] && len == 2)
+           if (memEQs(elem, len, "IO"))
                tmpRef = MUTABLE_SV(GvIOp(gv));
            break;
        case 'N':
-           if (len == 4 && strEQ(second_letter, "AME"))
+           if (memEQs(elem, len, "NAME"))
                sv = newSVhek(GvNAME_HEK(gv));
            break;
        case 'P':
-           if (len == 7 && strEQ(second_letter, "ACKAGE")) {
+           if (memEQs(elem, len, "PACKAGE")) {
                const HV * const stash = GvSTASH(gv);
                const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
                sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
            }
            break;
        case 'S':
-           if (len == 6 && strEQ(second_letter, "CALAR"))
+           if (memEQs(elem, len, "SCALAR"))
                tmpRef = GvSVn(gv);
            break;
        }
@@ -902,7 +901,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
                }
            }
            else
-               sv_setpvs(retval, "");
+                SvPVCLEAR(retval);
        }
        else if (s && len) {
            s += --len;
@@ -913,7 +912,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
            SvNIOK_off(sv);
        }
        else
-           sv_setpvs(retval, "");
+            SvPVCLEAR(retval);
        SvSETMAGIC(sv);
     }
     return count;
@@ -984,7 +983,7 @@ PP(pp_undef)
     case SVt_PVCV:
        if (cv_const_sv((const CV *)sv))
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
-                          "Constant subroutine %"SVf" undefined",
+                          "Constant subroutine %" SVf " undefined",
                           SVfARG(CvANON((const CV *)sv)
                              ? newSVpvs_flags("(anonymous)", SVs_TEMP)
                              : sv_2mortal(newSVhek(
@@ -2978,7 +2977,7 @@ PP(pp_sin)
              (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0))) {
              SET_NUMERIC_STANDARD();
              /* diag_listed_as: Can't take log of %g */
-             DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
+             DIE(aTHX_ "Can't take %s of %" NVgf, neg_report, value);
          }
       }
       switch (op_type) {
@@ -3250,7 +3249,7 @@ PP(pp_length)
        }
     } else {
        if (!SvPADTMP(TARG)) {
-           sv_setsv_nomg(TARG, &PL_sv_undef);
+            sv_set_undef(TARG);
        } else { /* TARG is on stack at this point and is overwriten by SETs.
                    This branch is the odd one out, so put TARG by default on
                    stack earlier to let local SP go out of liveness sooner */
@@ -3448,7 +3447,7 @@ PP(pp_substr)
                repl = SvPV_const(repl_sv_copy, repl_len);
            }
            if (!SvOK(sv))
-               sv_setpvs(sv, "");
+                SvPVCLEAR(sv);
            sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
            SvREFCNT_dec(repl_sv_copy);
        }
@@ -3644,7 +3643,7 @@ PP(pp_chr)
     if (UNLIKELY(SvAMAGIC(top)))
        top = sv_2num(top);
     if (UNLIKELY(isinfnansv(top)))
-        Perl_croak(aTHX_ "Cannot chr %"NVgf, SvNV(top));
+        Perl_croak(aTHX_ "Cannot chr %" NVgf, SvNV(top));
     else {
         if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
             && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
@@ -3659,7 +3658,7 @@ PP(pp_chr)
                    top = top2;
                }
                 Perl_warner(aTHX_ packWARN(WARN_UTF8),
-                            "Invalid negative number (%"SVf") in chr", SVfARG(top));
+                            "Invalid negative number (%" SVf ") in chr", SVfARG(top));
             }
             value = UNICODE_REPLACEMENT;
         } else {
@@ -3791,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
        }
 
@@ -4091,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
@@ -4307,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
@@ -4405,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.
@@ -4517,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);
@@ -5708,14 +5707,16 @@ PP(pp_reverse)
 PP(pp_split)
 {
     dSP; dTARG;
-    AV *ary = PL_op->op_flags & OPf_STACKED ? (AV *)POPs : NULL;
+    AV *ary = (   (PL_op->op_private & OPpSPLIT_ASSIGN) /* @a = split */
+               && (PL_op->op_flags & OPf_STACKED))      /* @{expr} = split */
+               ? (AV *)POPs : NULL;
     IV limit = POPi;                   /* note, negative is forever */
     SV * const sv = POPs;
     STRLEN len;
     const char *s = SvPV_const(sv, len);
     const bool do_utf8 = DO_UTF8(sv);
     const char *strend = s + len;
-    PMOP *pm;
+    PMOP *pm = cPMOPx(PL_op);
     REGEXP *rx;
     SV *dstr;
     const char *m;
@@ -5731,38 +5732,40 @@ PP(pp_split)
     I32 base;
     const U8 gimme = GIMME_V;
     bool gimme_scalar;
-    const I32 oldsave = PL_savestack_ix;
+    I32 oldsave = PL_savestack_ix;
     U32 make_mortal = SVs_TEMP;
     bool multiline = 0;
     MAGIC *mg = NULL;
 
-#ifdef DEBUGGING
-    Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
-#else
-    pm = (PMOP*)POPs;
-#endif
-    if (!pm)
-       DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s);
     rx = PM_GETRE(pm);
 
     TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
              (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
 
+    /* handle @ary = split(...) optimisation */
+    if (PL_op->op_private & OPpSPLIT_ASSIGN) {
+        if (!(PL_op->op_flags & OPf_STACKED)) {
+            if (PL_op->op_private & OPpSPLIT_LEX) {
+                if (PL_op->op_private & OPpLVAL_INTRO)
+                    SAVECLEARSV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+                ary = (AV *)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff);
+            }
+            else {
+                GV *gv =
 #ifdef USE_ITHREADS
-    if (pm->op_pmreplrootu.op_pmtargetoff) {
-       ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)));
-       goto have_av;
-    }
+                        MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
 #else
-    if (pm->op_pmreplrootu.op_pmtargetgv) {
-       ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
-       goto have_av;
-    }
+                        pm->op_pmreplrootu.op_pmtargetgv;
 #endif
-    else if (pm->op_targ)
-       ary = (AV *)PAD_SVl(pm->op_targ);
-    if (ary) {
-       have_av:
+                if (PL_op->op_private & OPpLVAL_INTRO)
+                    ary = save_ary(gv);
+                else
+                    ary = GvAVn(gv);
+            }
+            /* skip anything pushed by OPpLVAL_INTRO above */
+            oldsave = PL_savestack_ix;
+        }
+
        realarray = 1;
        PUTBACK;
        av_extend(ary,0);
@@ -5786,19 +5789,20 @@ PP(pp_split)
            make_mortal = 0;
        }
     }
+
     base = SP - PL_stack_base;
     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++;
        }
     }
@@ -5815,9 +5819,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
@@ -5855,7 +5859,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)
@@ -6091,7 +6095,7 @@ PP(pp_split)
            while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
                if (TOPs && !make_mortal)
                    sv_2mortal(TOPs);
-               *SP-- = &PL_sv_undef;
+               *SP-- = NULL;
                iters--;
            }
        }
@@ -6138,7 +6142,7 @@ PP(pp_split)
     }
 
     GETTARGET;
-    PUSHi(iters);
+    XPUSHi(iters);
     RETURN;
 }