Do the required JMPENV dance when invoking a nested runloop for defer {} block in order to correctly handle exceptions thrown and caught entirely within it

Author: leonerd

pod/perldelta.pod

@@ -368,7 +368,19 @@ manager will later use a regex to expand these into links.
 
 =item *
 
-XXX
+Exceptions thrown and caught entirely within a C<defer {}> or C<finally {}>
+block no longer stop the outer run-loop.
+
+Code such as the following would stop running the contents of the C<defer>
+block once the inner exception in the inner C<try>/C<catch> block was caught.
+This has now been fixed, and runs as expected. ([GH #23064]).
+
+    defer {
+        try { die "It breaks\n"; }
+        catch ($e) { warn $e }
+
+        say "This line would never run";
+    }
 
 =back
 

pp_ctl.c

@@ -6475,9 +6475,37 @@ _invoke_defer_block(pTHX_ U8 type, void *_arg)
     SAVETMPS;
 
     SAVEOP();
+    OP *was_PL_op = PL_op;
     PL_op = start;
 
-    CALLRUNOPS(aTHX);
+    dJMPENV;
+    int ret;
+    JMPENV_PUSH(ret);
+    switch (ret) {
+    case 0: /* normal start */
+redo_body:
+        CALLRUNOPS(aTHX);
+        break;
+
+    case 3: /* exception happened */
+        if (PL_restartjmpenv == PL_top_env) {
+            if (!PL_restartop)
+                break;
+            PL_restartjmpenv = NULL;
+            PL_op = PL_restartop;
+            PL_restartop = NULL;
+            goto redo_body;
+        }
+
+        /* FALLTHROUGH */
+    default:
+        JMPENV_POP;
+        PL_op = was_PL_op;
+        JMPENV_JUMP(ret);
+        NOT_REACHED;
+    }
+
+    JMPENV_POP;
 
     FREETMPS;
     LEAVE;

t/op/defer.t

@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan 28;
+plan 29;
 
 use feature 'defer';
 no warnings 'experimental::defer';
@@ -285,3 +285,18 @@ no warnings 'experimental::defer';
     like($e, qr/^Bareword "foo" not allowed while "strict subs" in use at /,
         'Error from finalization');
 }
+
+# GH#23604
+{
+    my $ok;
+    {
+        defer {
+            eval { die "Ignore this error\n" };
+            $ok .= "k";
+        }
+
+        $ok .= "o";
+    }
+
+    is($ok, "ok", 'eval{die} inside defer does not stop runloop');
+}

t/op/try.t

@@ -330,6 +330,25 @@ no warnings 'experimental::try';
     ok($finally_invoked, 'finally block still invoked for side-effects');
 }
 
+# Variant of GH#23604
+{
+    my $ok;
+    try {
+        # nothing
+    }
+    catch ($e) {}
+    finally {
+        try {
+            die "Ignore this error\n"
+        }
+        catch ($e) {}
+
+        $ok = "ok";
+    }
+
+    is($ok, "ok", 'try{die} inside try/finally does not stop runloop');
+}
+
 # Nicer compiletime errors
 {
     my $e;