prevent multiple evaluations of ERRSV

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 22e1cea..c9e4ac4 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2000,8 +2000,12 @@ PP(pp_dbstate)
            PUSHSUB_DB(cx);
            cx->blk_sub.retop = PL_op->op_next;
            CvDEPTH(cv)++;
+           if (CvDEPTH(cv) >= 2) {
+               PERL_STACK_OVERFLOW_CHECK();
+               pad_push(CvPADLIST(cv), CvDEPTH(cv));
+           }
            SAVECOMPPAD();
-           PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+           PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
            RETURNOP(CvSTART(cv));
        }
     }
@@ -2799,13 +2803,17 @@ PP(pp_goto)
            FREETMPS;
            cxix = dopoptosub(cxstack_ix);
            if (cxix < 0)
+           {
+               SvREFCNT_dec(cv);
                DIE(aTHX_ "Can't goto subroutine outside a subroutine");
+           }
            if (cxix < cxstack_ix)
                dounwind(cxix);
            TOPBLOCK(cx);
            SPAGAIN;
            /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
            if (CxTYPE(cx) == CXt_EVAL) {
+               SvREFCNT_dec(cv);
                if (CxREALEVAL(cx))
                /* diag_listed_as: Can't goto subroutine from an eval-%s */
                    DIE(aTHX_ "Can't goto subroutine from an eval-string");
@@ -2814,7 +2822,10 @@ PP(pp_goto)
                    DIE(aTHX_ "Can't goto subroutine from an eval-block");
            }
            else if (CxMULTICALL(cx))
+           {
+               SvREFCNT_dec(cv);
                DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
+           }
            if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
                AV* av = cx->blk_sub.argarray;
 
@@ -2889,11 +2900,6 @@ PP(pp_goto)
            }
            else {
                PADLIST * const padlist = CvPADLIST(cv);
-               if (CxTYPE(cx) == CXt_EVAL) {
-                   PL_in_eval = CxOLD_IN_EVAL(cx);
-                   PL_eval_root = cx->blk_eval.old_eval_root;
-                   cx->cx_type = CXt_SUB;
-               }
                cx->blk_sub.cv = cv;
                cx->blk_sub.olddepth = CvDEPTH(cv);
 
@@ -3261,7 +3267,7 @@ Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
                switch (cond) {
                case FIND_RUNCV_padid_eq:
                    if (!CvPADLIST(cv)
-                    || PadlistNAMES(CvPADLIST(cv)) != (PADNAMELIST *)arg)
+                    || PadlistNAMES(CvPADLIST(cv)) != INT2PTR(PADNAMELIST *, arg))
                        continue;
                    return cv;
                case FIND_RUNCV_level_eq:
@@ -3439,6 +3445,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
        PERL_CONTEXT *cx;
        I32 optype;                     /* Used by POPEVAL. */
        SV *namesv;
+        SV *errsv = NULL;
 
        cx = NULL;
        namesv = NULL;
@@ -3461,6 +3468,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
            LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE.  */
        }
 
+       errsv = ERRSV;
        if (in_require) {
            if (!cx) {
                /* If cx is still NULL, it means that we didn't go in the
@@ -3474,13 +3482,13 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
                            SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
                           &PL_sv_undef, 0);
            Perl_croak(aTHX_ "%"SVf"Compilation failed in require",
-                      SVfARG(ERRSV
-                                ? ERRSV
+                      SVfARG(errsv
+                                ? errsv
                                 : newSVpvs_flags("Unknown error\n", SVs_TEMP)));
        }
        else {
-           if (!*(SvPVx_nolen_const(ERRSV))) {
-               sv_setpvs(ERRSV, "Compilation error");
+           if (!*(SvPV_nolen_const(errsv))) {
+               sv_setpvs(errsv, "Compilation error");
            }
        }
        if (gimme != G_ARRAY) PUSHs(&PL_sv_undef);
@@ -5361,8 +5369,10 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
            if (SvOK(out)) {
                status = SvIV(out);
            }
-            else if (SvTRUE(ERRSV)) {
-                err = newSVsv(ERRSV);
+            else {
+                SV * const errsv = ERRSV;
+                if (SvTRUE_NN(errsv))
+                    err = newSVsv(errsv);
             }
        }