RT #124156: death during unwinding causes crash

v5.19.3-139-g2537512 changed POPSUB and POPFORMAT so that they also
unwind the relevant portion of the scope stack. This (sensible) change
means that during exception handling, contexts and savestack frames are
popped in lock-step, rather than all the contexts being popped followed by
all the savestack contents.

However, LEAVE_SCOPE() is now called by POPSUB/FORMAT, which can trigger
destructors, tied method calls etc, which themselves may croak. The new
unwinding will see the old sub context still on the context stack and call
POPSUB on it again, leading to double frees etc.

At this late stage in code freeze, the least invasive change is to
use an unused bit in cx->blk_u16 to indicate that POPSUB has already
been called on this context frame.

Sometime later, this whole area of code really needs a thorough overhaul.
The main issue is that if cxstack_ix-- is done too early, then calling
destructors etc can overwrite the current context frame while we're still
using using it; if cxstack_ix-- is done too late, then that stack frame
can end up getting unwound twice.

cop.h

@@ -617,6 +617,7 @@ struct block_format {
 	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)
@@ -639,6 +640,8 @@ struct block_format {
 #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)),		\
@@ -665,6 +668,7 @@ struct block_format {
 	LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);		\
 	if (sv && (CvDEPTH((const CV*)sv) = olddepth))			\
 	    sv = NULL;						\
+        }                                                               \
     } STMT_END
 
 #define LEAVESUB(sv)							\
@@ -674,13 +678,16 @@ struct block_format {
 
 #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 */
@@ -770,7 +777,10 @@ struct block_loop {
 #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;			\

t/op/sub.t

@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan( tests => 36 );
+plan( tests => 37 );
 
 sub empty_sub {}
 
@@ -245,3 +245,32 @@ sub predeclared {
 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");
+}