cx->blk_format.gv = gv; \
cx->blk_format.retop = (retop); \
cx->blk_format.dfoutgv = PL_defoutgv; \
+ cx->blk_u16 = 0; \
if (!CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv); \
CvDEPTH(cv)++; \
SvREFCNT_inc_void(cx->blk_format.dfoutgv)
#define POPSUB(cx,sv) \
STMT_START { \
const I32 olddepth = cx->blk_sub.olddepth; \
+ if (!(cx->blk_u16 & CxPOPSUB_DONE)) { \
+ cx->blk_u16 |= CxPOPSUB_DONE; \
RETURN_PROBE(CvNAMED(cx->blk_sub.cv) \
? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv)) \
: GvENAME(CvGV(cx->blk_sub.cv)), \
CLEAR_ARGARRAY(cx->blk_sub.argarray); \
} \
} \
+ } \
sv = MUTABLE_SV(cx->blk_sub.cv); \
LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
if (sv && (CvDEPTH((const CV*)sv) = olddepth)) \
#define POPFORMAT(cx) \
STMT_START { \
+ if (!(cx->blk_u16 & CxPOPSUB_DONE)) { \
CV * const cv = cx->blk_format.cv; \
GV * const dfuot = cx->blk_format.dfoutgv; \
+ cx->blk_u16 |= CxPOPSUB_DONE; \
setdefout(dfuot); \
LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
if (!--CvDEPTH(cv)) \
SvREFCNT_dec_NN(cx->blk_format.cv); \
SvREFCNT_dec_NN(dfuot); \
+ } \
} STMT_END
/* eval context */
#define CxLABEL_len(c,len) (0 + CopLABEL_len((c)->blk_oldcop, len))
#define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags))
#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
-#define CxLVAL(c) (0 + (c)->blk_u16)
+#define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff))
+/* POPSUB has already been performed on this context frame */
+#define CxPOPSUB_DONE 0x100
+
#define PUSHLOOP_PLAIN(cx, s) \
cx->blk_loop.resetsp = s - PL_stack_base; \
set_up_inc('../lib');
}
-plan( tests => 36 );
+plan(tests => 39);
sub empty_sub {}
predeclared(); # set $x to 42
$main::x = $main::x = "You should not see this.";
inside_predeclared(); # run test
+
+# RT #124156 death during unwinding causes crash
+# the tie allows us to trigger another die while cleaning up the stack
+# from an earlier die.
+
+{
+ package RT124156;
+
+ sub TIEHASH { bless({}, $_[0]) }
+ sub EXISTS { 0 }
+ sub FETCH { undef }
+ sub STORE { }
+ sub DELETE { die "outer\n" }
+
+ my @value;
+ eval {
+ @value = sub {
+ @value = sub {
+ my %a;
+ tie %a, "RT124156";
+ local $a{foo} = "bar";
+ die "inner";
+ ("dd2a", "dd2b");
+ }->();
+ ("cc3a", "cc3b");
+ }->();
+ };
+ ::is($@, "outer\n", "RT124156 plain");
+
+ my $destroyed = 0;
+ sub DESTROY { $destroyed = 1 }
+
+ sub f {
+ my $x;
+ my $f = sub {
+ $x = 1; # force closure
+ my %a;
+ tie %a, "RT124156";
+ local $a{foo} = "bar";
+ die "inner";
+ };
+ bless $f, 'RT124156';
+ $f->();
+ }
+
+ eval { f(); };
+ # as opposed to $@ eq "Can't undef active subroutine"
+ ::is($@, "outer\n", "RT124156 depth");
+ ::is($destroyed, 1, "RT124156 freed cv");
+}