AV * savearray;
AV * argarray;
I32 olddepth;
- PAD *oldcomppad;
+ PAD *oldcomppad; /* the *current* PL_comppad */
+ PAD *prevcomppad; /* the caller's PL_comppad */
};
/* Above here is the same for sub and format. */
GV * gv;
GV * dfoutgv;
+ PAD *prevcomppad; /* the caller's PL_comppad */
};
/* base for the next two macros. Don't use directly.
\
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
+ cx->blk_sub.prevcomppad = PL_comppad; \
cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \
cx->blk_sub.retop = NULL; \
SvREFCNT_inc_simple_void_NN(cv);
cx->blk_format.gv = gv; \
cx->blk_format.retop = (retop); \
cx->blk_format.dfoutgv = PL_defoutgv; \
+ cx->blk_format.prevcomppad = PL_comppad; \
cx->blk_u16 = 0; \
SvREFCNT_inc_simple_void_NN(cv); \
CvDEPTH(cv)++; \
} \
sv = MUTABLE_SV(cx->blk_sub.cv); \
LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
+ PL_comppad = cx->blk_sub.prevcomppad; \
+ PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
CvDEPTH((const CV*)sv) = olddepth; \
} STMT_END
cx->blk_u16 |= CxPOPSUB_DONE; \
setdefout(dfuot); \
LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
+ PL_comppad = cx->blk_format.prevcomppad; \
+ PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
--CvDEPTH(cv); \
SvREFCNT_dec_NN(cx->blk_format.cv); \
SvREFCNT_dec_NN(dfuot); \
PERL_STACK_OVERFLOW_CHECK(); \
Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
} \
- SAVECOMPPAD(); \
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
multicall_cv = cv; \
multicall_cop = CvSTART(cv); \
CvDEPTH(multicall_cv) = cx->blk_sub.olddepth; \
LEAVESUB(multicall_cv); \
POPBLOCK(cx,PL_curpm); \
+ LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
+ PL_comppad = cx->blk_sub.prevcomppad; \
+ PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
POPSTACK; \
CATCH_SET(multicall_oldcatch); \
LEAVE; \
CV * const _nOnclAshIngNamE_ = the_cv; \
CV * const cv = _nOnclAshIngNamE_; \
PADLIST * const padlist = CvPADLIST(cv); \
+ PAD * const prevcomppad = cx->blk_sub.prevcomppad; \
cx = &cxstack[cxstack_ix]; \
assert(cx->cx_type & CXp_MULTICALL); \
CvDEPTH(multicall_cv) = cx->blk_sub.olddepth; \
LEAVESUB(multicall_cv); \
cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \
PUSHSUB(cx); \
+ cx->blk_sub.prevcomppad = prevcomppad ; /* undo PUSHSUB */ \
if (!(flags & CXp_SUB_RE_FAKE)) \
CvDEPTH(cv)++; \
if (CvDEPTH(cv) >= 2) { \
PERL_STACK_OVERFLOW_CHECK(); \
Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
} \
- SAVECOMPPAD(); \
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
multicall_cv = cv; \
multicall_cop = CvSTART(cv); \
PERL_STACK_OVERFLOW_CHECK();
pad_push(CvPADLIST(cv), CvDEPTH(cv));
}
- SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
RETURNOP(CvSTART(cv));
}
assert(PL_scopestack_ix == cx->blk_oldscopesp);
oldsave = PL_scopestack[cx->blk_oldscopesp - 1];
LEAVE_SCOPE(oldsave);
+ PL_comppad = cx->blk_sub.prevcomppad;
+ PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
/* A destructor called during LEAVE_SCOPE could have undefined
* our precious cv. See bug #99850. */
pad_push(padlist, CvDEPTH(cv));
}
PL_curcop = cx->blk_oldcop;
- SAVECOMPPAD();
+ cx->blk_sub.prevcomppad = PL_comppad;
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
if (CxHASARGS(cx))
{
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, depth);
}
- SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(padlist, depth);
if (LIKELY(hasargs)) {
AV *const av = MUTABLE_AV(PAD_SVl(0));
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, CvDEPTH(cv));
}
- SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
if (hasargs) {
PERL_STACK_OVERFLOW_CHECK();
pad_push(CvPADLIST(cv), CvDEPTH(cv));
}
- SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
setdefout(gv); /* locally select filehandle so $% et al work */
U8 flags = (CXp_SUB_RE |
((newcv == caller_cv) ? CXp_SUB_RE_FAKE : 0));
if (last_pushed_cv) {
+ /* PUSH/POP_MULTICALL save and restore the
+ * caller's PL_comppad; if we call multiple subs
+ * using the same CX block, we have to save and
+ * unwind the varying PL_comppad's ourselves,
+ * especially restoring the right PL_comppad on
+ * backtrack - so save it on the save stack */
+ SAVECOMPPAD();
CHANGE_MULTICALL_FLAGS(newcv, flags);
}
else {
}
ncx->blk_sub.oldcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
ncx->blk_sub.oldcomppad);
+ ncx->blk_sub.prevcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
+ ncx->blk_sub.prevcomppad);
break;
case CXt_EVAL:
ncx->blk_eval.old_namesv = sv_dup_inc(ncx->blk_eval.old_namesv,
set_up_inc('../lib');
}
-plan(tests => 57);
+plan(tests => 58);
sub empty_sub {}
::is($destroyed, 1, "RT124156 freed cv");
}
+# trapping dying while popping a scope needs to have the right pad at all
+# times. Localising a tied array then dying in STORE raises an exception
+# while leaving g(). Note that using an object and destructor wouldn't be
+# sufficient since DESTROY is called with call_sv(...,G_EVAL).
+# We make sure that the first item in every sub's pad is a lexical with
+# different values per sub.
+
+{
+ package tie_exception;
+ sub TIEARRAY { my $x = 4; bless [0] }
+ sub FETCH { my $x = 5; 1 }
+ sub STORE { my $x = 6; die if $_[0][0]; $_[0][0] = 1 }
+
+ my $y;
+ sub f { my $x = 7; eval { g() }; $y = $x }
+ sub g {
+ my $x = 8;
+ my @a;
+ tie @a, "tie_exception";
+ local $a[0];
+ }
+
+ f();
+ local $::TODO = "sub unwinding not safe yet";
+ ::is($y, 7, "tie_exception");
+}
+
# check that return pops extraneous stuff from the stack