From fc6e609e613c36ececcd37d4c7f023be35a36578 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Thu, 24 Dec 2015 19:44:05 +0000
Subject: [PATCH] dounwind(): do a POPBLOCK for final cx frame.

Previously dounwind() relied on the caller to a TOPBLOCK or POPBLOCK
following the call to dounwind(). It's debatable who should be
responsible. Arguably its more efficient for dounwind() not to do a
POPBLOCK, since the caller will probably immediately follow on with
POPFOO; POPBLOCK for the next context frame anyway.

Logically however, dounwind() should do this, and its not possible
for the caller to do so retrospectively, as context frame cxstack_ix + 1
may have been overwritten by the time dounwind returns.

Also, the changes in this branch mean that the old PL_tmps_floor is now
saved in the context struct rather than on the save stack, so code that
does C<dounwind(-1); LEAVE_SCOPE();> will no longer automatically
restore PL_tmps_floor. With thiis commit, it will.

The change to pp_return reflects that we now need to copy any return args
*before* donwind() is called, so that "return $1" will mg_get($1) while
the correct (inner) PL_curpm is still in scope.
---
 pp_ctl.c   | 20 +++++++++++++-------
 t/op/sub.t | 14 +++++++++++++-
 2 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 10e258b..ce67973 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1506,12 +1506,10 @@ S_dopoptowhen(pTHX_ I32 startingblock)
 }
 
 /* dounwind(): pop all contexts above (but not including) cxix.
- * Leaves cxstack_ix equal to cxix. Note that for efficiency, it doesn't
- * call POPBLOCK at all; the caller should do
- *     CX_LEAVE_SCOPE; POPFOO; POPBLOCK
- * or
- *     TOPBLOCK
- * as appropriate.
+ * Note that it clears the savestack frame associated with each popped
+ * context entry, but doesn't free any temps.
+ * It does a POPBLOCK of the last frame that it pops, and leaves
+ * cxstack_ix equal to cxix.
  */
 
 void
@@ -1561,8 +1559,12 @@ Perl_dounwind(pTHX_ I32 cxix)
 	    POPFORMAT(cx);
 	    break;
 	}
+        if (cxstack_ix == cxix + 1) {
+            POPBLOCK(cx);
+        }
 	cxstack_ix--;
     }
+
 }
 
 void
@@ -2417,7 +2419,9 @@ PP(pp_return)
         PUTBACK;
         if (cx->blk_gimme != G_VOID)
             leave_adjust_stacks(MARK, PL_stack_base + cx->blk_oldsp,
-                                cx->blk_gimme, 3);
+                    cx->blk_gimme,
+                    CxTYPE(cx) == CXt_SUB && CvLVALUE(cx->blk_sub.cv)
+                        ? 3 : 0);
         SPAGAIN;
 	dounwind(cxix);
         cx = &cxstack[cxix]; /* CX stack may have been realloced */
@@ -2469,6 +2473,8 @@ PP(pp_return)
     }
 }
 
+/* find the enclosing loop or labelled loop and dounwind() back to it.
+ * opname is for errors */
 
 static I32
 S_unwind_loop(pTHX_ const char * const opname)
diff --git a/t/op/sub.t b/t/op/sub.t
index a299447..05fd018 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan(tests => 62);
+plan(tests => 63);
 
 sub empty_sub {}
 
@@ -403,3 +403,15 @@ is(join('-', 10, check_ret(-1,5)),      "10",  "check_ret(-1,5) list");
     sub g { !!(my $x = bless []); }
     f(g());
 }
+
+# return should have the right PL_curpm while copying its return args
+
+sub curpm {
+    "b" =~ /(.)/;
+    {
+        "c" =~ /(.)/;
+        return $1;
+    }
+}
+"a" =~ /(.)/;
+is(curpm(), 'c', 'return and PL_curpm');
-- 
1.8.3.1