This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make all the SvPV*force* macros always return sv with SvPOK_only, as API
[perl5.git] / pp_hot.c
index cbdcb90..e04d5ca 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -74,7 +74,7 @@ PP(pp_null)
     return NORMAL;
 }
 
-/* This is sometimes called directly by pp_coreargs. */
+/* This is sometimes called directly by pp_coreargs and pp_grepstart. */
 PP(pp_pushmark)
 {
     dVAR;
@@ -112,30 +112,34 @@ PP(pp_and)
 
 PP(pp_sassign)
 {
-    dVAR; dSP; dPOPTOPssrl;
+    dVAR; dSP;
+    /* sassign keeps its args in the optree traditionally backwards.
+       So we pop them differently.
+    */
+    SV *left = POPs; SV *right = TOPs;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
        SV * const temp = left;
        left = right; right = temp;
     }
-    if (PL_tainting && PL_tainted && !SvTAINTED(left))
+    if (PL_tainting && PL_tainted && !SvTAINTED(right))
        TAINT_NOT;
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
-       SV * const cv = SvRV(left);
+       SV * const cv = SvRV(right);
        const U32 cv_type = SvTYPE(cv);
-       const bool is_gv = isGV_with_GP(right);
+       const bool is_gv = isGV_with_GP(left);
        const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
 
        if (!got_coderef) {
            assert(SvROK(cv));
        }
 
-       /* Can do the optimisation if right (LVALUE) is not a typeglob,
-          left (RVALUE) is a reference to something, and we're in void
+       /* Can do the optimisation if left (LVALUE) is not a typeglob,
+          right (RVALUE) is a reference to something, and we're in void
           context. */
        if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
            /* Is the target symbol table currently empty?  */
-           GV * const gv = gv_fetchsv_nomg(right, GV_NOINIT, SVt_PVGV);
+           GV * const gv = gv_fetchsv_nomg(left, GV_NOINIT, SVt_PVGV);
            if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
                /* Good. Create a new proxy constant subroutine in the target.
                   The gv becomes a(nother) reference to the constant.  */
@@ -145,7 +149,7 @@ PP(pp_sassign)
                SvPCS_IMPORTED_on(gv);
                SvRV_set(gv, value);
                SvREFCNT_inc_simple_void(value);
-               SETs(right);
+               SETs(left);
                RETURN;
            }
        }
@@ -153,7 +157,7 @@ PP(pp_sassign)
        /* Need to fix things up.  */
        if (!is_gv) {
            /* Need to fix GV.  */
-           right = MUTABLE_SV(gv_fetchsv_nomg(right,GV_ADD, SVt_PVGV));
+           left = MUTABLE_SV(gv_fetchsv_nomg(left,GV_ADD, SVt_PVGV));
        }
 
        if (!got_coderef) {
@@ -167,7 +171,7 @@ PP(pp_sassign)
                   all sorts of fun as the reference to our new sub is
                   donated to the GV that we're about to assign to.
                */
-               SvRV_set(left, MUTABLE_SV(newCONSTSUB(GvSTASH(right), NULL,
+               SvRV_set(right, MUTABLE_SV(newCONSTSUB(GvSTASH(left), NULL,
                                                      SvRV(cv))));
                SvREFCNT_dec(cv);
                LEAVE_with_name("sassign_coderef");
@@ -193,20 +197,20 @@ PP(pp_sassign)
 
                SvREFCNT_inc_void(source);
                SvREFCNT_dec(upgraded);
-               SvRV_set(left, MUTABLE_SV(source));
+               SvRV_set(right, MUTABLE_SV(source));
            }
        }
 
     }
     if (
-      SvTEMP(right) && !SvSMAGICAL(right) && SvREFCNT(right) == 1 &&
-      (!isGV_with_GP(right) || SvFAKE(right)) && ckWARN(WARN_MISC)
+      SvTEMP(left) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 &&
+      (!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC)
     )
        Perl_warner(aTHX_
            packWARN(WARN_MISC), "Useless assignment to a temporary"
        );
-    SvSetMagicSV(right, left);
-    SETs(right);
+    SvSetMagicSV(left, right);
+    SETs(left);
     RETURN;
 }
 
@@ -325,7 +329,7 @@ PP(pp_readline)
     dSP;
     if (TOPs) {
        SvGETMAGIC(TOPs);
-       tryAMAGICunTARGET(iter_amg, 0, 0);
+       tryAMAGICunTARGETlist(iter_amg, 0, 0);
        PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
     }
     else PL_last_in_gv = PL_argvgv, PL_stack_sp--;
@@ -366,7 +370,7 @@ PP(pp_preinc)
        PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC;
     if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
        Perl_croak_no_modify(aTHX);
-    if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+    if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
     {
        SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1));
@@ -505,9 +509,7 @@ PP(pp_add)
        unsigned code below is actually shorter than the old code. :-)
     */
 
-    SvIV_please_nomg(svr);
-
-    if (SvIOK(svr)) {
+    if (SvIV_please_nomg(svr)) {
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
           we know the left is integer.  */
@@ -523,8 +525,7 @@ PP(pp_add)
               lots of code to speed up what is probably a rarish case.  */
        } else {
            /* Left operand is defined, so is it IV? */
-           SvIV_please_nomg(svl);
-           if (SvIOK(svl)) {
+           if (SvIV_please_nomg(svl)) {
                if ((auvok = SvUOK(svl)))
                    auv = SvUVX(svl);
                else {
@@ -995,6 +996,8 @@ PP(pp_aassign)
        case SVt_PVAV:
            ary = MUTABLE_AV(sv);
            magic = SvMAGICAL(ary) != 0;
+           ENTER;
+           SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
            av_clear(ary);
            av_extend(ary, lastrelem - relem);
            i = 0;
@@ -1015,6 +1018,7 @@ PP(pp_aassign)
            }
            if (PL_delaymagic & DM_ARRAY_ISA)
                SvSETMAGIC(MUTABLE_SV(ary));
+           LEAVE;
            break;
        case SVt_PVHV: {                                /* normal hash */
                SV *tmpstr;
@@ -1022,6 +1026,8 @@ PP(pp_aassign)
 
                hash = MUTABLE_HV(sv);
                magic = SvMAGICAL(hash) != 0;
+               ENTER;
+               SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
                hv_clear(hash);
                firsthashrelem = relem;
 
@@ -1058,6 +1064,7 @@ PP(pp_aassign)
                    do_oddball(hash, relem, firstrelem);
                    relem++;
                }
+               LEAVE;
            }
            break;
        default:
@@ -1085,71 +1092,77 @@ PP(pp_aassign)
        }
     }
     if (PL_delaymagic & ~DM_DELAY) {
+       /* Will be used to set PL_tainting below */
+       UV tmp_uid  = PerlProc_getuid();
+       UV tmp_euid = PerlProc_geteuid();
+       UV tmp_gid  = PerlProc_getgid();
+       UV tmp_egid = PerlProc_getegid();
+
        if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
-           (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
-                           (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1,
+           (void)setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid  : (Uid_t)-1,
+                           (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1,
                            (Uid_t)-1);
 #else
 #  ifdef HAS_SETREUID
-           (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
-                          (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1);
+           (void)setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid  : (Uid_t)-1,
+                          (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1);
 #  else
 #    ifdef HAS_SETRUID
            if ((PL_delaymagic & DM_UID) == DM_RUID) {
-               (void)setruid(PL_uid);
+               (void)setruid(PL_delaymagic_uid);
                PL_delaymagic &= ~DM_RUID;
            }
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
            if ((PL_delaymagic & DM_UID) == DM_EUID) {
-               (void)seteuid(PL_euid);
+               (void)seteuid(PL_delaymagic_euid);
                PL_delaymagic &= ~DM_EUID;
            }
 #    endif /* HAS_SETEUID */
            if (PL_delaymagic & DM_UID) {
-               if (PL_uid != PL_euid)
+               if (PL_delaymagic_uid != PL_delaymagic_euid)
                    DIE(aTHX_ "No setreuid available");
-               (void)PerlProc_setuid(PL_uid);
+               (void)PerlProc_setuid(PL_delaymagic_uid);
            }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
-           PL_uid = PerlProc_getuid();
-           PL_euid = PerlProc_geteuid();
+           tmp_uid  = PerlProc_getuid();
+           tmp_euid = PerlProc_geteuid();
        }
        if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
-           (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
-                           (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1,
+           (void)setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid  : (Gid_t)-1,
+                           (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1,
                            (Gid_t)-1);
 #else
 #  ifdef HAS_SETREGID
-           (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
-                          (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1);
+           (void)setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid  : (Gid_t)-1,
+                          (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1);
 #  else
 #    ifdef HAS_SETRGID
            if ((PL_delaymagic & DM_GID) == DM_RGID) {
-               (void)setrgid(PL_gid);
+               (void)setrgid(PL_delaymagic_gid);
                PL_delaymagic &= ~DM_RGID;
            }
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
            if ((PL_delaymagic & DM_GID) == DM_EGID) {
-               (void)setegid(PL_egid);
+               (void)setegid(PL_delaymagic_egid);
                PL_delaymagic &= ~DM_EGID;
            }
 #    endif /* HAS_SETEGID */
            if (PL_delaymagic & DM_GID) {
-               if (PL_gid != PL_egid)
+               if (PL_delaymagic_gid != PL_delaymagic_egid)
                    DIE(aTHX_ "No setregid available");
-               (void)PerlProc_setgid(PL_gid);
+               (void)PerlProc_setgid(PL_delaymagic_gid);
            }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
-           PL_gid = PerlProc_getgid();
-           PL_egid = PerlProc_getegid();
+           tmp_gid  = PerlProc_getgid();
+           tmp_egid = PerlProc_getegid();
        }
-       PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
+       PL_tainting |= (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid));
     }
     PL_delaymagic = 0;
 
@@ -1199,6 +1212,8 @@ PP(pp_qr)
     REGEXP * rx = PM_GETRE(pm);
     SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
     SV * const rv = sv_newmortal();
+    CV **cvp;
+    CV *cv;
 
     SvUPGRADE(rv, SVt_IV);
     /* For a subroutine describing itself as "This is a hacky workaround" I'm
@@ -1210,6 +1225,12 @@ PP(pp_qr)
     SvRV_set(rv, MUTABLE_SV(reg_temp_copy(NULL, rx)));
     SvROK_on(rv);
 
+    cvp = &( ((struct regexp*)SvANY(SvRV(rv)))->qr_anoncv);
+    if ((cv = *cvp) && CvCLONE(*cvp)) {
+       *cvp = cv_clone(cv);
+       SvREFCNT_dec(cv);
+    }
+
     if (pkg) {
        HV *const stash = gv_stashsv(pkg, GV_ADD);
        SvREFCNT_dec(pkg);
@@ -1277,7 +1298,9 @@ PP(pp_match)
         pm->op_pmflags & PMf_USED
 #endif
     ) {
+        DEBUG_r(PerlIO_printf(Perl_debug_log, "?? already matched once"));
       failure:
+
        if (gimme == G_ARRAY)
            RETURN;
        RETPUSHNO;
@@ -1291,8 +1314,10 @@ PP(pp_match)
        rx = PM_GETRE(pm);
     }
 
-    if (RX_MINLEN(rx) > (I32)len)
+    if (RX_MINLEN(rx) > (I32)len) {
+        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
        goto failure;
+    }
 
     truebase = t = s;
 
@@ -1325,14 +1350,14 @@ PP(pp_match)
            || SvTEMP(TARG) || SvAMAGIC(TARG) || PL_sawampersand
            || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
        r_flags |= REXEC_COPY_STR;
-    if (SvSCREAM(TARG))
-       r_flags |= REXEC_SCREAM;
 
   play_it_again:
     if (global && RX_OFFS(rx)[0].start != -1) {
        t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
-       if ((s + RX_MINLEN(rx)) > strend || s < truebase)
+       if ((s + RX_MINLEN(rx)) > strend || s < truebase) {
+           DEBUG_r(PerlIO_printf(Perl_debug_log, "Regex match can't succeed, so not even tried\n"));
            goto nope;
+       }
        if (update_minmatch++)
            minmatch = had_zerolen;
     }
@@ -1347,9 +1372,6 @@ PP(pp_match)
        if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
             && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
-            && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
-                || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
-                     && (r_flags & REXEC_SCREAM)))
             && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
            goto yup;
     }
@@ -1384,7 +1406,10 @@ PP(pp_match)
                s = RX_OFFS(rx)[i].start + truebase;
                if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 ||
                    len < 0 || len > strend - s)
-                   DIE(aTHX_ "panic: pp_match start/end pointers");
+                   DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, "
+                       "start=%ld, end=%ld, s=%p, strend=%p, len=%"UVuf,
+                       (long) i, (long) RX_OFFS(rx)[i].start,
+                       (long)RX_OFFS(rx)[i].end, s, strend, (UV) len);
                sv_setpvn(*SP, s, len);
                if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
                    SvUTF8_on(*SP);
@@ -1512,9 +1537,9 @@ yup:                                      /* Confirmed by INTUIT */
        RX_OFFS(rx)[0].start = s - truebase;
        RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
     }
-    /* including RX_NPARENS(rx) in the below code seems highly suspicious.
-       -dmq */
-    RX_NPARENS(rx) = RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;     /* used by @-, @+, and $^N */
+    /* match via INTUIT shouldn't have any captures. Let @-, @+, $^N know */
+    assert(!RX_NPARENS(rx));
+    RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
@@ -1567,6 +1592,7 @@ Perl_do_readline(pTHX)
                    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
                        IoFLAGS(io) &= ~IOf_START;
                        do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL);
+                       SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */
                        sv_setpvs(GvSVn(PL_last_in_gv), "-");
                        SvSETMAGIC(GvSV(PL_last_in_gv));
                        fp = IoIFP(io);
@@ -1592,7 +1618,7 @@ Perl_do_readline(pTHX)
            && ckWARN2(WARN_GLOB, WARN_CLOSED))
        {
            if (type == OP_GLOB)
-               Perl_warner(aTHX_ packWARN(WARN_GLOB),
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB),
                            "glob failed (can't start child: %s)",
                            Strerror(errno));
            else
@@ -1705,7 +1731,7 @@ Perl_do_readline(pTHX)
                }
            }
            for (t1 = SvPVX_const(sv); *t1; t1++)
-               if (!isALPHA(*t1) && !isDIGIT(*t1) &&
+               if (!isALNUMC(*t1) &&
                    strchr("$&*(){}[]'\";\\|?<>~`", *t1))
                        break;
            if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
@@ -1767,7 +1793,7 @@ PP(pp_helem)
         * Try to preserve the existenceness of a tied hash
         * element by using EXISTS and DELETE if possible.
         * Fallback to FETCH and STORE otherwise. */
-       if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+       if (SvCANEXISTDELETE(hv))
            preeminent = hv_exists_ent(hv, keysv, 0);
     }
 
@@ -1835,7 +1861,7 @@ PP(pp_iter)
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
     if (!CxTYPE_is_LOOP(cx))
-       DIE(aTHX_ "panic: pp_iter");
+       DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx));
 
     itersvp = CxITERVAR(cx);
     if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
@@ -1876,7 +1902,7 @@ PP(pp_iter)
        /* don't risk potential race */
        if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
            /* safe to reuse old SV */
-           sv_setiv(*itersvp, cx->blk_loop.state_u.lazyiv.cur++);
+           sv_setiv(*itersvp, cx->blk_loop.state_u.lazyiv.cur);
        }
        else
        {
@@ -1884,17 +1910,15 @@ PP(pp_iter)
             * completely new SV for closures/references to work as they
             * used to */
            oldsv = *itersvp;
-           *itersvp = newSViv(cx->blk_loop.state_u.lazyiv.cur++);
+           *itersvp = newSViv(cx->blk_loop.state_u.lazyiv.cur);
            SvREFCNT_dec(oldsv);
        }
 
-       /* Handle end of range at IV_MAX */
-       if ((cx->blk_loop.state_u.lazyiv.cur == IV_MIN) &&
-           (cx->blk_loop.state_u.lazyiv.end == IV_MAX))
-       {
-           cx->blk_loop.state_u.lazyiv.cur++;
-           cx->blk_loop.state_u.lazyiv.end++;
-       }
+       if (cx->blk_loop.state_u.lazyiv.cur == IV_MAX) {
+           /* Handle end of range at IV_MAX */
+           cx->blk_loop.state_u.lazyiv.end = IV_MIN;
+       } else
+           ++cx->blk_loop.state_u.lazyiv.cur;
 
        RETPUSHYES;
     }
@@ -2113,7 +2137,7 @@ PP(pp_subst)
 
   force_it:
     if (!pm || !s)
-       DIE(aTHX_ "panic: pp_subst");
+       DIE(aTHX_ "panic: pp_subst, pm=%p, s=%p", pm, s);
 
     strend = s + len;
     slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len;
@@ -2128,8 +2152,6 @@ PP(pp_subst)
     r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand
            || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
               ? REXEC_COPY_STR : 0;
-    if (SvSCREAM(TARG))
-       r_flags |= REXEC_SCREAM;
 
     orig = m = s;
     if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
@@ -2141,10 +2163,7 @@ PP(pp_subst)
        /* How to do it in subst? */
 /*     if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
-            && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY)
-            && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
-                || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
-                     && (r_flags & REXEC_SCREAM))))
+            && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY))
            goto yup;
 */
     }
@@ -2225,7 +2244,6 @@ PP(pp_subst)
        }
        d = s;
        PL_curpm = pm;
-       SvSCREAM_off(TARG);     /* disable possible screamer */
        if (once) {
            if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
                rxtainted |= SUBST_TAINT_PAT;
@@ -2341,20 +2359,20 @@ PP(pp_subst)
            }
            m = RX_OFFS(rx)[0].start + orig;
            if (doutf8 && !SvUTF8(dstr))
-               sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+               sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv);
             else
-               sv_catpvn(dstr, s, m-s);
+               sv_catpvn_nomg(dstr, s, m-s);
            s = RX_OFFS(rx)[0].end + orig;
            if (clen)
-               sv_catpvn(dstr, c, clen);
+               sv_catpvn_nomg(dstr, c, clen);
            if (once)
                break;
        } while (CALLREGEXEC(rx, s, strend, orig, s == m,
                             TARG, NULL, r_flags));
        if (doutf8 && !DO_UTF8(TARG))
-           sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
+           sv_catpvn_nomg_utf8_upgrade(dstr, s, strend - s, nsv);
        else
-           sv_catpvn(dstr, s, strend - s);
+           sv_catpvn_nomg(dstr, s, strend - s);
 
        if (rpm->op_pmflags & PMf_NONDESTRUCT) {
            /* From here on down we're using the copy, and leaving the original
@@ -2492,7 +2510,8 @@ PP(pp_leavesub)
        MARK = newsp + 1;
        if (MARK <= SP) {
            if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-               if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
+               if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
+                    && !SvMAGICAL(TOPs)) {
                    *MARK = SvREFCNT_inc(TOPs);
                    FREETMPS;
                    sv_2mortal(*MARK);
@@ -2504,7 +2523,8 @@ PP(pp_leavesub)
                    SvREFCNT_dec(sv);
                }
            }
-           else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
+           else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
+                    && !SvMAGICAL(TOPs)) {
                *MARK = TOPs;
            }
            else
@@ -2518,7 +2538,8 @@ PP(pp_leavesub)
     }
     else if (gimme == G_ARRAY) {
        for (MARK = newsp + 1; MARK <= SP; MARK++) {
-           if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1) {
+           if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1
+                || SvMAGICAL(*MARK)) {
                *MARK = sv_mortalcopy(*MARK);
                TAINT_NOT;      /* Each item is independent */
            }
@@ -2581,9 +2602,9 @@ PP(pp_entersub)
        else {
            const char *sym;
            STRLEN len;
-           sym = SvPV_nomg_const(sv, len);
-           if (!sym)
+           if (!SvOK(sv))
                DIE(aTHX_ PL_no_usym, "a subroutine");
+           sym = SvPV_nomg_const(sv, len);
            if (PL_op->op_private & HINT_STRICT_REFS)
                DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
            cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
@@ -2628,15 +2649,15 @@ try_autoload:
            {
                cv = GvCV(autogv);
            }
-           /* sorry */
            else {
+              sorry:
                sub_name = sv_newmortal();
                gv_efullname3(sub_name, gv, NULL);
                DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
            }
        }
        if (!cv)
-           DIE(aTHX_ "Not a CODE reference");
+           goto sorry;
        goto retry;
     }
 
@@ -2667,11 +2688,6 @@ try_autoload:
        PUSHSUB(cx);
        cx->blk_sub.retop = PL_op->op_next;
        CvDEPTH(cv)++;
-       /* XXX This would be a natural place to set C<PL_compcv = cv> so
-        * that eval'' ops within this sub know the correct lexical space.
-        * Owing the speed considerations, we choose instead to search for
-        * the cv using find_runcv() when calling doeval().
-        */
        if (CvDEPTH(cv) >= 2) {
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv));
@@ -2889,6 +2905,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
        }
        SvROK_on(sv);
        SvSETMAGIC(sv);
+       SvGETMAGIC(sv);
     }
     if (SvGMAGICAL(sv)) {
        /* copy the sv without magic to prevent magic from being
@@ -2935,7 +2952,11 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     GV* gv;
     HV* stash;
     SV *packsv = NULL;
-    SV * const sv = *(PL_stack_base + TOPMARK + 1);
+    SV * const sv = PL_stack_base + TOPMARK == PL_stack_sp
+       ? (Perl_croak(aTHX_ "Can't call method \"%"SVf"\" without a "
+                           "package or object reference", SVfARG(meth)),
+          (SV *)NULL)
+       : *(PL_stack_base + TOPMARK + 1);
 
     PERL_ARGS_ASSERT_METHOD_COMMON;
 
@@ -3044,8 +3065,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */