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.

1 files changed, 51 insertions, 1 deletions

diff --git a/t/op/sub.t b/t/op/sub.t
index 154ab1ec87..e8a561ad23 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan( tests => 36 );
+plan(tests => 39);
 
 sub empty_sub {}
 
@@ -245,3 +245,53 @@ 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 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");
+}