This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
ext/POSIX/lib/POSIX.pod: Make verbatim line fit in 79 cols
[perl5.git] / pp_ctl.c
diff --git a/pp_ctl.c b/pp_ctl.c
index 6726802..011da56 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -165,7 +165,8 @@ PP(pp_regcomp)
     }
 
 
     }
 
 
-    if (TAINTING_get && TAINT_get) {
+    assert(TAINTING_get || !TAINT_get);
+    if (TAINT_get) {
        SvTAINTED_on((SV*)new_re);
         RX_TAINT_on(new_re);
     }
        SvTAINTED_on((SV*)new_re);
         RX_TAINT_on(new_re);
     }
@@ -312,10 +313,16 @@ PP(pp_substcont)
        SV * const sv
            = (pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ;
        MAGIC *mg;
        SV * const sv
            = (pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ;
        MAGIC *mg;
+
+        /* the string being matched against may no longer be a string,
+         * e.g. $_=0; s/.../$_++/ge */
+
+        if (!SvPOK(sv))
+            SvPV_force_nomg_nolen(sv);
+
        if (!(mg = mg_find_mglob(sv))) {
            mg = sv_magicext_mglob(sv);
        }
        if (!(mg = mg_find_mglob(sv))) {
            mg = sv_magicext_mglob(sv);
        }
-       assert(SvPOK(sv));
        MgBYTEPOS_set(mg, sv, SvPVX(sv), m - orig);
     }
     if (old != rx)
        MgBYTEPOS_set(mg, sv, SvPVX(sv), m - orig);
     }
     if (old != rx)
@@ -922,35 +929,29 @@ PP(pp_grepstart)
     dSP;
     SV *src;
 
     dSP;
     SV *src;
 
-    if (PL_stack_base + *PL_markstack_ptr == SP) {
+    if (PL_stack_base + TOPMARK == SP) {
        (void)POPMARK;
        if (GIMME_V == G_SCALAR)
            mXPUSHi(0);
        RETURNOP(PL_op->op_next->op_next);
     }
        (void)POPMARK;
        if (GIMME_V == G_SCALAR)
            mXPUSHi(0);
        RETURNOP(PL_op->op_next->op_next);
     }
-    PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
+    PL_stack_sp = PL_stack_base + TOPMARK + 1;
     Perl_pp_pushmark(aTHX);                            /* push dst */
     Perl_pp_pushmark(aTHX);                            /* push src */
     ENTER_with_name("grep");                                   /* enter outer scope */
 
     SAVETMPS;
     Perl_pp_pushmark(aTHX);                            /* push dst */
     Perl_pp_pushmark(aTHX);                            /* push src */
     ENTER_with_name("grep");                                   /* enter outer scope */
 
     SAVETMPS;
-    if (PL_op->op_private & OPpGREP_LEX)
-       SAVESPTR(PAD_SVl(PL_op->op_targ));
-    else
-       SAVE_DEFSV;
+    SAVE_DEFSV;
     ENTER_with_name("grep_item");                                      /* enter inner scope */
     SAVEVPTR(PL_curpm);
 
     ENTER_with_name("grep_item");                                      /* enter inner scope */
     SAVEVPTR(PL_curpm);
 
-    src = PL_stack_base[*PL_markstack_ptr];
+    src = PL_stack_base[TOPMARK];
     if (SvPADTMP(src)) {
     if (SvPADTMP(src)) {
-       src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+       src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
        PL_tmps_floor++;
     }
     SvTEMP_off(src);
        PL_tmps_floor++;
     }
     SvTEMP_off(src);
-    if (PL_op->op_private & OPpGREP_LEX)
-       PAD_SVl(PL_op->op_targ) = src;
-    else
-       DEFSV_set(src);
+    DEFSV_set(src);
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
@@ -962,7 +963,7 @@ PP(pp_mapwhile)
 {
     dSP;
     const I32 gimme = GIMME_V;
 {
     dSP;
     const I32 gimme = GIMME_V;
-    I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
+    I32 items = (SP - PL_stack_base) - TOPMARK; /* how many new items */
     I32 count;
     I32 shift;
     SV** src;
     I32 count;
     I32 shift;
     SV** src;
@@ -1063,7 +1064,7 @@ PP(pp_mapwhile)
     LEAVE_with_name("grep_item");                                      /* exit inner scope */
 
     /* All done yet? */
     LEAVE_with_name("grep_item");                                      /* exit inner scope */
 
     /* All done yet? */
-    if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
+    if (PL_markstack_ptr[-1] > TOPMARK) {
 
        (void)POPMARK;                          /* pop top */
        LEAVE_with_name("grep");                                        /* exit outer scope */
 
        (void)POPMARK;                          /* pop top */
        LEAVE_with_name("grep");                                        /* exit outer scope */
@@ -1072,15 +1073,8 @@ PP(pp_mapwhile)
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
-           if (PL_op->op_private & OPpGREP_LEX) {
-               SV* sv = sv_newmortal();
-               sv_setiv(sv, items);
-               PUSHs(sv);
-           }
-           else {
                dTARGET;
                XPUSHi(items);
                dTARGET;
                XPUSHi(items);
-           }
        }
        else if (gimme == G_ARRAY)
            SP += items;
        }
        else if (gimme == G_ARRAY)
            SP += items;
@@ -1098,10 +1092,7 @@ PP(pp_mapwhile)
             src = sv_mortalcopy(src);
         }
        SvTEMP_off(src);
             src = sv_mortalcopy(src);
         }
        SvTEMP_off(src);
-       if (PL_op->op_private & OPpGREP_LEX)
-           PAD_SVl(PL_op->op_targ) = src;
-       else
-           DEFSV_set(src);
+       DEFSV_set(src);
 
        RETURNOP(cLOGOP->op_other);
     }
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -1200,7 +1191,11 @@ PP(pp_flop)
                     /* The wraparound of signed integers is undefined
                      * behavior, but here we aim for count >=1, and
                      * negative count is just wrong. */
                     /* The wraparound of signed integers is undefined
                      * behavior, but here we aim for count >=1, and
                      * negative count is just wrong. */
-                    if (n < 1)
+                    if (n < 1
+#if IVSIZE > Size_t_size
+                        || n > SSize_t_MAX
+#endif
+                        )
                         overflow = TRUE;
                 }
                 if (overflow)
                         overflow = TRUE;
                 }
                 if (overflow)
@@ -1343,22 +1338,17 @@ I32
 Perl_block_gimme(pTHX)
 {
     const I32 cxix = dopoptosub(cxstack_ix);
 Perl_block_gimme(pTHX)
 {
     const I32 cxix = dopoptosub(cxstack_ix);
+    U8 gimme;
     if (cxix < 0)
        return G_VOID;
 
     if (cxix < 0)
        return G_VOID;
 
-    switch (cxstack[cxix].blk_gimme) {
-    case G_VOID:
-       return G_VOID;
-    case G_SCALAR:
-       return G_SCALAR;
-    case G_ARRAY:
-       return G_ARRAY;
-    default:
-       Perl_croak(aTHX_ "panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
-    }
-    NOT_REACHED; /* NOTREACHED */
+    gimme = (cxstack[cxix].blk_gimme & G_WANT);
+    if (!gimme)
+       Perl_croak(aTHX_ "panic: bad gimme: %d\n", gimme);
+    return gimme;
 }
 
 }
 
+
 I32
 Perl_is_lvalue_sub(pTHX)
 {
 I32
 Perl_is_lvalue_sub(pTHX)
 {
@@ -1818,7 +1808,7 @@ PP(pp_caller)
                       cx->blk_sub.retop, TRUE);
     if (!lcop)
        lcop = cx->blk_oldcop;
                       cx->blk_sub.retop, TRUE);
     if (!lcop)
        lcop = cx->blk_oldcop;
-    mPUSHi((I32)CopLINE(lcop));
+    mPUSHu(CopLINE(lcop));
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
@@ -2144,7 +2134,6 @@ PP(pp_enteriter)
        save_pushptrptr(gv, SvREFCNT_inc(*svp), SAVEt_GVSV);
        *svp = newSV(0);
        itervar = (void *)gv;
        save_pushptrptr(gv, SvREFCNT_inc(*svp), SAVEt_GVSV);
        *svp = newSV(0);
        itervar = (void *)gv;
-       save_aliased_sv(gv);
     }
     else {
        SV * const sv = POPs;
     }
     else {
        SV * const sv = POPs;
@@ -2273,17 +2262,46 @@ PP(pp_leaveloop)
     return NORMAL;
 }
 
     return NORMAL;
 }
 
-STATIC void
-S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
-                       PERL_CONTEXT *cx, PMOP *newpm)
+
+/* This duplicates most of pp_leavesub, but with additional code to handle
+ * return args in lvalue context. It was forked from pp_leavesub to
+ * avoid slowing down that function any further.
+ *
+ * Any changes made to this function may need to be copied to pp_leavesub
+ * and vice-versa.
+ */
+
+PP(pp_leavesublv)
 {
 {
-    const bool ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
+    dSP;
+    SV **newsp;
+    SV **mark;
+    PMOP *newpm;
+    I32 gimme;
+    PERL_CONTEXT *cx;
+    SV *sv;
+    bool ref;
+    const char *what = NULL;
+
+    if (CxMULTICALL(&cxstack[cxstack_ix])) {
+        /* entry zero of a stack is always PL_sv_undef, which
+         * simplifies converting a '()' return into undef in scalar context */
+        assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+       return 0;
+    }
+
+    POPBLOCK(cx,newpm);
+    cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
+    TAINT_NOT;
+
+    mark = newsp + 1;
+
+    ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
     if (gimme == G_SCALAR) {
        if (CxLVAL(cx) && !ref) {     /* Leave it as it is if we can. */
            SV *sv;
     if (gimme == G_SCALAR) {
        if (CxLVAL(cx) && !ref) {     /* Leave it as it is if we can. */
            SV *sv;
-           const char *what = NULL;
-           if (MARK < SP) {
-               assert(MARK+1 == SP);
+           if (MARK <= SP) {
+               assert(MARK == SP);
                if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
                    !SvSMAGICAL(TOPs)) {
                    what =
                if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
                    !SvSMAGICAL(TOPs)) {
                    what =
@@ -2296,33 +2314,34 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                /* sub:lvalue{} will take us here. */
                what = "undef";
            }
                /* sub:lvalue{} will take us here. */
                what = "undef";
            }
+          croak:
            LEAVE;
            LEAVE;
-           cxstack_ix--;
            POPSUB(cx,sv);
            POPSUB(cx,sv);
+           cxstack_ix--;
            PL_curpm = newpm;
            LEAVESUB(sv);
            Perl_croak(aTHX_
                      "Can't return %s from lvalue subroutine", what
            );
        }
            PL_curpm = newpm;
            LEAVESUB(sv);
            Perl_croak(aTHX_
                      "Can't return %s from lvalue subroutine", what
            );
        }
-       if (MARK < SP) {
+       if (MARK <= SP) {
              copy_sv:
                if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
                    if (!SvPADTMP(*SP)) {
              copy_sv:
                if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
                    if (!SvPADTMP(*SP)) {
-                       *++newsp = SvREFCNT_inc(*SP);
+                       *MARK = SvREFCNT_inc(*SP);
                        FREETMPS;
                        FREETMPS;
-                       sv_2mortal(*newsp);
+                       sv_2mortal(*MARK);
                    }
                    else {
                        /* FREETMPS could clobber it */
                        SV *sv = SvREFCNT_inc(*SP);
                        FREETMPS;
                    }
                    else {
                        /* FREETMPS could clobber it */
                        SV *sv = SvREFCNT_inc(*SP);
                        FREETMPS;
-                       *++newsp = sv_mortalcopy(sv);
+                       *MARK = sv_mortalcopy(sv);
                        SvREFCNT_dec(sv);
                    }
                }
                else
                        SvREFCNT_dec(sv);
                    }
                }
                else
-                   *++newsp =
+                   *MARK =
                      SvPADTMP(*SP)
                       ? sv_mortalcopy(*SP)
                       : !SvTEMP(*SP)
                      SvPADTMP(*SP)
                       ? sv_mortalcopy(*SP)
                       : !SvTEMP(*SP)
@@ -2330,9 +2349,11 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                          : *SP;
        }
        else {
                          : *SP;
        }
        else {
-           EXTEND(newsp,1);
-           *++newsp = &PL_sv_undef;
+           MEXTEND(MARK, 0);
+           *MARK = &PL_sv_undef;
        }
        }
+        SP = MARK;
+
        if (CxLVAL(cx) & OPpDEREF) {
            SvGETMAGIC(TOPs);
            if (!SvOK(TOPs)) {
        if (CxLVAL(cx) & OPpDEREF) {
            SvGETMAGIC(TOPs);
            if (!SvOK(TOPs)) {
@@ -2343,209 +2364,110 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
     else if (gimme == G_ARRAY) {
        assert (!(CxLVAL(cx) & OPpDEREF));
        if (ref || !CxLVAL(cx))
     else if (gimme == G_ARRAY) {
        assert (!(CxLVAL(cx) & OPpDEREF));
        if (ref || !CxLVAL(cx))
-           while (++MARK <= SP)
-               *++newsp =
+           for (; MARK <= SP; MARK++)
+               *MARK =
                       SvFLAGS(*MARK) & SVs_PADTMP
                           ? sv_mortalcopy(*MARK)
                     : SvTEMP(*MARK)
                           ? *MARK
                           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
                       SvFLAGS(*MARK) & SVs_PADTMP
                           ? sv_mortalcopy(*MARK)
                     : SvTEMP(*MARK)
                           ? *MARK
                           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
-       else while (++MARK <= SP) {
+       else for (; MARK <= SP; MARK++) {
            if (*MARK != &PL_sv_undef
                    && (SvPADTMP(*MARK) || SvREADONLY(*MARK))
            ) {
            if (*MARK != &PL_sv_undef
                    && (SvPADTMP(*MARK) || SvREADONLY(*MARK))
            ) {
-                   const bool ro = cBOOL( SvREADONLY(*MARK) );
-                   SV *sv;
                    /* Might be flattened array after $#array =  */
                    /* Might be flattened array after $#array =  */
-                   PUTBACK;
-                   LEAVE;
-                   cxstack_ix--;
-                   POPSUB(cx,sv);
-                   PL_curpm = newpm;
-                   LEAVESUB(sv);
-              /* diag_listed_as: Can't return %s from lvalue subroutine */
-                   Perl_croak(aTHX_
-                       "Can't return a %s from lvalue subroutine",
-                        ro ? "readonly value" : "temporary");
+                    what = SvREADONLY(*MARK)
+                            ? "a readonly value" : "a temporary";
+                    goto croak;
            }
            }
-           else
-               *++newsp =
-                   SvTEMP(*MARK)
-                      ? *MARK
-                      : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
+           else if (!SvTEMP(*MARK))
+               *MARK = sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
        }
     }
        }
     }
-    PL_stack_sp = newsp;
+    PUTBACK;
+
+    LEAVE;
+    POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
+    cxstack_ix--;
+    PL_curpm = newpm;  /* ... and pop $1 et al */
+    LEAVESUB(sv);
+
+    return cx->blk_sub.retop;
 }
 
 }
 
+
 PP(pp_return)
 {
     dSP; dMARK;
     PERL_CONTEXT *cx;
 PP(pp_return)
 {
     dSP; dMARK;
     PERL_CONTEXT *cx;
-    bool popsub2 = FALSE;
-    bool clear_errsv = FALSE;
-    bool lval = FALSE;
-    I32 gimme;
-    SV **newsp;
-    PMOP *newpm;
-    I32 optype = 0;
-    SV *namesv;
-    SV *sv;
-    OP *retop = NULL;
-
+    SV **oldsp;
     const I32 cxix = dopoptosub(cxstack_ix);
 
     const I32 cxix = dopoptosub(cxstack_ix);
 
-    if (cxix < 0) {
-       if (CxMULTICALL(cxstack)) { /* In this case we must be in a
-                                    * sort block, which is a CXt_NULL
-                                    * not a CXt_SUB */
-           dounwind(0);
-           PL_stack_base[1] = *PL_stack_sp;
-           PL_stack_sp = PL_stack_base + 1;
-           return 0;
-       }
-       else
-           DIE(aTHX_ "Can't return outside a subroutine");
-    }
-    if (cxix < cxstack_ix)
+    assert(cxstack_ix >= 0);
+    if (cxix < cxstack_ix) {
+        if (cxix < 0) {
+            if (CxMULTICALL(cxstack)) { /* In this case we must be in a
+                                         * sort block, which is a CXt_NULL
+                                         * not a CXt_SUB */
+                dounwind(0);
+                /* if we were in list context, we would have to splice out
+                 * any junk before the return args, like we do in the general
+                 * pp_return case, e.g.
+                 *   sub f { for (junk1, junk2) { return arg1, arg2 }}
+                 */
+                assert(cxstack[0].blk_gimme == G_SCALAR);
+                return 0;
+            }
+            else
+                DIE(aTHX_ "Can't return outside a subroutine");
+        }
        dounwind(cxix);
        dounwind(cxix);
+    }
 
 
-    if (CxMULTICALL(&cxstack[cxix])) {
-       gimme = cxstack[cxix].blk_gimme;
-       if (gimme == G_VOID)
-           PL_stack_sp = PL_stack_base;
-       else if (gimme == G_SCALAR) {
-           PL_stack_base[1] = *PL_stack_sp;
-           PL_stack_sp = PL_stack_base + 1;
-       }
-       return 0;
+    cx = &cxstack[cxix];
+
+    oldsp = PL_stack_base + cx->blk_oldsp;
+    if (oldsp != MARK) {
+        /* Handle extra junk on the stack. For example,
+         *    for (1,2) { return 3,4 }
+         * leaves 1,2,3,4 on the stack. In list context we
+         * have to splice out the 1,2; In scalar context for
+         *    for (1,2) { return }
+         * we need to set sp = oldsp so that pp_leavesub knows
+         * to push &PL_sv_undef onto the stack.
+         * Note that in pp_return we only do the extra processing
+         * required to handle junk; everything else we leave to
+         * pp_leavesub.
+         */
+        SSize_t nargs = SP - MARK;
+        if (nargs) {
+            if (cx->blk_gimme == G_ARRAY) {
+                /* shift return args to base of call stack frame */
+                Move(MARK + 1, oldsp + 1, nargs, SV*);
+                PL_stack_sp  = oldsp + nargs;
+            }
+        }
+        else
+            PL_stack_sp  = oldsp;
     }
 
     }
 
-    POPBLOCK(cx,newpm);
+    /* fall through to a normal exit */
     switch (CxTYPE(cx)) {
     switch (CxTYPE(cx)) {
-    case CXt_SUB:
-       popsub2 = TRUE;
-       lval = !!CvLVALUE(cx->blk_sub.cv);
-       retop = cx->blk_sub.retop;
-       cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
-       break;
     case CXt_EVAL:
     case CXt_EVAL:
-       if (!(PL_in_eval & EVAL_KEEPERR))
-           clear_errsv = TRUE;
-       POPEVAL(cx);
-       namesv = cx->blk_eval.old_namesv;
-       retop = cx->blk_eval.retop;
-       if (CxTRYBLOCK(cx))
-           break;
-       if (optype == OP_REQUIRE &&
-           (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
-       {
-           /* Unassume the success we assumed earlier. */
-           (void)hv_delete(GvHVn(PL_incgv),
-                           SvPVX_const(namesv),
-                            SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
-                           G_DISCARD);
-           DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv));
-       }
-       break;
+        return CxTRYBLOCK(cx)
+            ? Perl_pp_leavetry(aTHX)
+            : Perl_pp_leaveeval(aTHX);
+    case CXt_SUB:
+        return CvLVALUE(cx->blk_sub.cv)
+            ? Perl_pp_leavesublv(aTHX)
+            : Perl_pp_leavesub(aTHX);
     case CXt_FORMAT:
     case CXt_FORMAT:
-       retop = cx->blk_sub.retop;
-       POPFORMAT(cx);
-       break;
+        return Perl_pp_leavewrite(aTHX);
     default:
        DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
     }
     default:
        DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
     }
-
-    TAINT_NOT;
-    if (lval) S_return_lvalues(aTHX_ MARK, SP, newsp, gimme, cx, newpm);
-    else {
-      if (gimme == G_SCALAR) {
-       if (MARK < SP) {
-           if (popsub2) {
-               if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-                   if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
-                        && !SvMAGICAL(TOPs)) {
-                       *++newsp = SvREFCNT_inc(*SP);
-                       FREETMPS;
-                       sv_2mortal(*newsp);
-                   }
-                   else {
-                       sv = SvREFCNT_inc(*SP); /* FREETMPS could clobber it */
-                       FREETMPS;
-                       *++newsp = sv_mortalcopy(sv);
-                       SvREFCNT_dec(sv);
-                   }
-               }
-               else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1
-                         && !SvMAGICAL(*SP)) {
-                   *++newsp = *SP;
-               }
-               else
-                   *++newsp = sv_mortalcopy(*SP);
-           }
-           else
-               *++newsp = sv_mortalcopy(*SP);
-       }
-       else
-           *++newsp = &PL_sv_undef;
-      }
-      else if (gimme == G_ARRAY) {
-       while (++MARK <= SP) {
-           *++newsp = popsub2 && SvTEMP(*MARK) && SvREFCNT(*MARK) == 1
-                              && !SvGMAGICAL(*MARK)
-                       ? *MARK : sv_mortalcopy(*MARK);
-           TAINT_NOT;          /* Each item is independent */
-       }
-      }
-      PL_stack_sp = newsp;
-    }
-
-    LEAVE;
-    /* Stack values are safe: */
-    if (popsub2) {
-       cxstack_ix--;
-       POPSUB(cx,sv);  /* release CV and @_ ... */
-    }
-    else
-       sv = NULL;
-    PL_curpm = newpm;  /* ... and pop $1 et al */
-
-    LEAVESUB(sv);
-    if (clear_errsv) {
-       CLEAR_ERRSV();
-    }
-    return retop;
 }
 
 }
 
-/* This duplicates parts of pp_leavesub, so that it can share code with
- * pp_return */
-PP(pp_leavesublv)
-{
-    dSP;
-    SV **newsp;
-    PMOP *newpm;
-    I32 gimme;
-    PERL_CONTEXT *cx;
-    SV *sv;
-
-    if (CxMULTICALL(&cxstack[cxstack_ix]))
-       return 0;
-
-    POPBLOCK(cx,newpm);
-    cxstack_ix++; /* temporarily protect top context */
-
-    TAINT_NOT;
-
-    S_return_lvalues(aTHX_ newsp, SP, newsp, gimme, cx, newpm);
-
-    LEAVE;
-    POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
-    cxstack_ix--;
-    PL_curpm = newpm;  /* ... and pop $1 et al */
-
-    LEAVESUB(sv);
-    return cx->blk_sub.retop;
-}
 
 static I32
 S_unwind_loop(pTHX_ const char * const opname)
 
 static I32
 S_unwind_loop(pTHX_ const char * const opname)
@@ -2589,42 +2511,23 @@ S_unwind_loop(pTHX_ const char * const opname)
 PP(pp_last)
 {
     PERL_CONTEXT *cx;
 PP(pp_last)
 {
     PERL_CONTEXT *cx;
-    I32 pop2 = 0;
     I32 gimme;
     I32 gimme;
-    I32 optype;
     OP *nextop = NULL;
     SV **newsp;
     PMOP *newpm;
     OP *nextop = NULL;
     SV **newsp;
     PMOP *newpm;
-    SV *sv = NULL;
 
     S_unwind_loop(aTHX_ "last");
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
 
     S_unwind_loop(aTHX_ "last");
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
-    switch (CxTYPE(cx)) {
-    case CXt_LOOP_LAZYIV:
-    case CXt_LOOP_LAZYSV:
-    case CXt_LOOP_FOR:
-    case CXt_LOOP_PLAIN:
-       pop2 = CxTYPE(cx);
-       newsp = PL_stack_base + cx->blk_loop.resetsp;
-       nextop = cx->blk_loop.my_op->op_lastop->op_next;
-       break;
-    case CXt_SUB:
-       pop2 = CXt_SUB;
-       nextop = cx->blk_sub.retop;
-       break;
-    case CXt_EVAL:
-       POPEVAL(cx);
-       nextop = cx->blk_eval.retop;
-       break;
-    case CXt_FORMAT:
-       POPFORMAT(cx);
-       nextop = cx->blk_sub.retop;
-       break;
-    default:
-       DIE(aTHX_ "panic: last, type=%u", (unsigned) CxTYPE(cx));
-    }
+    assert(
+           CxTYPE(cx) == CXt_LOOP_LAZYIV
+        || CxTYPE(cx) == CXt_LOOP_LAZYSV
+        || CxTYPE(cx) == CXt_LOOP_FOR
+        || CxTYPE(cx) == CXt_LOOP_PLAIN
+    );
+    newsp = PL_stack_base + cx->blk_loop.resetsp;
+    nextop = cx->blk_loop.my_op->op_lastop->op_next;
 
     TAINT_NOT;
     PL_stack_sp = newsp;
 
     TAINT_NOT;
     PL_stack_sp = newsp;
@@ -2632,22 +2535,10 @@ PP(pp_last)
     LEAVE;
     cxstack_ix--;
     /* Stack values are safe: */
     LEAVE;
     cxstack_ix--;
     /* Stack values are safe: */
-    switch (pop2) {
-    case CXt_LOOP_LAZYIV:
-    case CXt_LOOP_PLAIN:
-    case CXt_LOOP_LAZYSV:
-    case CXt_LOOP_FOR:
-       POPLOOP(cx);    /* release loop vars ... */
-       LEAVE;
-       break;
-    case CXt_SUB:
-       POPSUB(cx,sv);  /* release CV and @_ ... */
-       break;
-    }
+    POPLOOP(cx);       /* release loop vars ... */
+    LEAVE;
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
-    LEAVESUB(sv);
-    PERL_UNUSED_VAR(optype);
     PERL_UNUSED_VAR(gimme);
     return nextop;
 }
     PERL_UNUSED_VAR(gimme);
     return nextop;
 }
@@ -3204,7 +3095,7 @@ Check for the cases 0 or 3 of cur_env.je_ret, only used inside an eval context.
 
 3 is used for a die caught by an inner eval - continue inner loop
 
 
 3 is used for a die caught by an inner eval - continue inner loop
 
-See cop.h: je_mustcatch, when set at any runlevel to TRUE, means eval ops must
+See F<cop.h>: je_mustcatch, when set at any runlevel to TRUE, means eval ops must
 establish a local jmpenv to handle exception traps.
 
 =cut
 establish a local jmpenv to handle exception traps.
 
 =cut
@@ -3255,8 +3146,8 @@ S_docatch(pTHX_ OP *o)
 =for apidoc find_runcv
 
 Locate the CV corresponding to the currently executing sub or eval.
 =for apidoc find_runcv
 
 Locate the CV corresponding to the currently executing sub or eval.
-If db_seqp is non_null, skip CVs that are in the DB package and populate
-*db_seqp with the cop sequence number at the point that the DB:: code was
+If C<db_seqp> is non_null, skip CVs that are in the DB package and populate
+C<*db_seqp> with the cop sequence number at the point that the DB:: code was
 entered.  (This allows debuggers to eval in the scope of the breakpoint
 rather than in the scope of the debugger itself.)
 
 entered.  (This allows debuggers to eval in the scope of the breakpoint
 rather than in the scope of the debugger itself.)
 
@@ -3591,11 +3482,14 @@ S_check_type_and_open(pTHX_ SV *name)
     /* checking here captures a reasonable error message when
      * PERL_DISABLE_PMC is true, but when PMC checks are enabled, the
      * user gets a confusing message about looking for the .pmc file
     /* checking here captures a reasonable error message when
      * PERL_DISABLE_PMC is true, but when PMC checks are enabled, the
      * user gets a confusing message about looking for the .pmc file
-     * rather than for the .pm file.
+     * rather than for the .pm file so do the check in S_doopen_pm when
+     * PMC is on instead of here. S_doopen_pm calls this func.
      * This check prevents a \0 in @INC causing problems.
      */
      * This check prevents a \0 in @INC causing problems.
      */
+#ifdef PERL_DISABLE_PMC
     if (!IS_SAFE_PATHNAME(p, len, "require"))
         return NULL;
     if (!IS_SAFE_PATHNAME(p, len, "require"))
         return NULL;
+#endif
 
     /* on Win32 stat is expensive (it does an open() and close() twice and
        a couple other IO calls), the open will fail with a dir on its own with
 
     /* on Win32 stat is expensive (it does an open() and close() twice and
        a couple other IO calls), the open will fail with a dir on its own with
@@ -3614,11 +3508,7 @@ S_check_type_and_open(pTHX_ SV *name)
     }
 #endif
 
     }
 #endif
 
-#if !defined(PERLIO_IS_STDIO)
     retio = PerlIO_openn(aTHX_ ":", PERL_SCRIPT_MODE, -1, 0, 0, NULL, 1, &name);
     retio = PerlIO_openn(aTHX_ ":", PERL_SCRIPT_MODE, -1, 0, 0, NULL, 1, &name);
-#else
-    retio = PerlIO_open(p, PERL_SCRIPT_MODE);
-#endif
 #ifdef WIN32
     /* EACCES stops the INC search early in pp_require to implement
        feature RT #113422 */
 #ifdef WIN32
     /* EACCES stops the INC search early in pp_require to implement
        feature RT #113422 */
@@ -3655,13 +3545,14 @@ S_doopen_pm(pTHX_ SV *name)
 
     if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
        SV *const pmcsv = sv_newmortal();
 
     if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
        SV *const pmcsv = sv_newmortal();
-       Stat_t pmcstat;
+       PerlIO * pmcio;
 
        SvSetSV_nosteal(pmcsv,name);
        sv_catpvs(pmcsv, "c");
 
 
        SvSetSV_nosteal(pmcsv,name);
        sv_catpvs(pmcsv, "c");
 
-       if (PerlLIO_stat(SvPV_nolen_const(pmcsv), &pmcstat) >= 0)
-           return check_type_and_open(pmcsv);
+       pmcio = check_type_and_open(pmcsv);
+       if (pmcio)
+           return pmcio;
     }
     return check_type_and_open(name);
 }
     }
     return check_type_and_open(name);
 }
@@ -4278,7 +4169,7 @@ PP(pp_entereval)
 
     /* prepare to compile string */
 
 
     /* prepare to compile string */
 
-    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
+    if (PERLDB_LINE_OR_SAVESRC && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     else {
        /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     else {
        /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
@@ -4295,7 +4186,7 @@ PP(pp_entereval)
 
     if (doeval(gimme, runcv, seq, saved_hh)) {
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
 
     if (doeval(gimme, runcv, seq, saved_hh)) {
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
-           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           ?  PERLDB_LINE_OR_SAVESRC
            :  PERLDB_SAVESRC_NOSUBS) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
            :  PERLDB_SAVESRC_NOSUBS) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
@@ -4307,7 +4198,7 @@ PP(pp_entereval)
        /* We have already left the scope set up earlier thanks to the LEAVE
           in doeval().  */
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
        /* We have already left the scope set up earlier thanks to the LEAVE
           in doeval().  */
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
-           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           ?  PERLDB_LINE_OR_SAVESRC
            :  PERLDB_SAVESRC_INVALID) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
            :  PERLDB_SAVESRC_INVALID) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
@@ -4325,10 +4216,11 @@ PP(pp_leaveeval)
     I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
     I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
-    const U8 save_flags = PL_op -> op_flags;
     I32 optype;
     SV *namesv;
     CV *evalcv;
     I32 optype;
     SV *namesv;
     CV *evalcv;
+    /* grab this value before POPEVAL restores old PL_in_eval */
+    bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR);
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
@@ -4360,9 +4252,8 @@ PP(pp_leaveeval)
     }
     else {
        LEAVE_with_name("eval");
     }
     else {
        LEAVE_with_name("eval");
-       if (!(save_flags & OPf_SPECIAL)) {
+        if (!keep)
            CLEAR_ERRSV();
            CLEAR_ERRSV();
-       }
     }
 
     RETURNOP(retop);
     }
 
     RETURNOP(retop);
@@ -4428,9 +4319,11 @@ PP(pp_leavetry)
     I32 gimme;
     PERL_CONTEXT *cx;
     I32 optype;
     I32 gimme;
     PERL_CONTEXT *cx;
     I32 optype;
+    OP *retop;
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
+    retop = cx->blk_eval.retop;
     POPEVAL(cx);
     PERL_UNUSED_VAR(optype);
 
     POPEVAL(cx);
     PERL_UNUSED_VAR(optype);
 
@@ -4440,7 +4333,7 @@ PP(pp_leavetry)
 
     LEAVE_with_name("eval_scope");
     CLEAR_ERRSV();
 
     LEAVE_with_name("eval_scope");
     CLEAR_ERRSV();
-    RETURN;
+    RETURNOP(retop);
 }
 
 PP(pp_entergiven)
 }
 
 PP(pp_entergiven)
@@ -4452,15 +4345,9 @@ PP(pp_entergiven)
     ENTER_with_name("given");
     SAVETMPS;
 
     ENTER_with_name("given");
     SAVETMPS;
 
-    if (PL_op->op_targ) {
-       SAVEPADSVANDMORTALIZE(PL_op->op_targ);
-       SvREFCNT_dec(PAD_SVl(PL_op->op_targ));
-       PAD_SVl(PL_op->op_targ) = SvREFCNT_inc_NN(POPs);
-    }
-    else {
-       SAVE_DEFSV;
-       DEFSV_set(POPs);
-    }
+    assert(!PL_op->op_targ); /* used to be set for lexical $_ */
+    SAVE_DEFSV;
+    DEFSV_set(POPs);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);
     PUSHGIVEN(cx);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);
     PUSHGIVEN(cx);
@@ -4593,11 +4480,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
            RETPUSHYES;
     }
 
            RETPUSHYES;
     }
 
-    if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) {
+    if (SvROK(e) && SvOBJECT(SvRV(e)) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) {
        DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
        Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
     }
        DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
        Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
     }
-    if (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
+    if (SvROK(d) && SvOBJECT(SvRV(d)) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
        object_on_left = TRUE;
 
     /* ~~ sub */
        object_on_left = TRUE;
 
     /* ~~ sub */
@@ -5621,11 +5508,5 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 }
 
 /*
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */
Unnamed repository; edit this file 'description' to name the repository.