Consistently call leave_common() before POPFOO

In some places the code does

    POPBLOCK(); POPFOO(); leave_common();

while in other places it does

    POPBLOCK(); leave_common(); POPFOO();

Make it do the latter consistently. This is because the next commit
will make *all* context types do a LEAVE_SCOPE(), not just the 'subish'
ones as now. This means that any context type that can return args needs
to preserve its args before doing the LEAVE_SCOPE()/POPFOO(), not just the
sub ones.

For example this lexical var is declared within a LOOP_PLAIN:

    sub foo {
        {
            my $x = 1;
            $x;
        }
    }

where the return value of the loop block ($x) is also the return value of
the sub. So let leave_common() make a mortal copy of $x before POPLOOP
frees the lexicals in the inner scope.

Similar comments apply to calling leave_common() before calling
dounwind().

Note that where the LEAVE_SCOPE() is located it not yet consistent;
sometimes it's part of the POPFOO macro, sometimes it's not, and so has to
be done explicitly just before calling POPBAR.

diff --git a/pp_ctl.c b/pp_ctl.c
index a1e7329..e400c57 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2089,6 +2089,7 @@ PP(pp_leave)
         ? newsp
         : leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
                                PL_op->op_private & OPpLVALUE);
+
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_with_name("block");
@@ -4292,13 +4293,13 @@ PP(pp_leaveeval)
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
+    if (gimme != G_VOID)
+        SP = leave_common(newsp, SP, newsp, gimme, SVs_TEMP, FALSE);
     POPEVAL(cx);
     namesv = cx->blk_eval.old_namesv;
     retop = cx->blk_eval.retop;
     evalcv = cx->blk_eval.cv;
 
-    if (gimme != G_VOID)
-        SP = leave_common(newsp, SP, newsp, gimme, SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
 #ifdef DEBUGGING
@@ -4394,13 +4395,13 @@ PP(pp_leavetry)
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
     retop = cx->blk_eval.retop;
-    POPEVAL(cx);
-    PERL_UNUSED_VAR(optype);
-
     SP = (gimme == G_VOID)
         ? newsp
         : leave_common(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
+    POPEVAL(cx);
+    PERL_UNUSED_VAR(optype);
+
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
@@ -4440,13 +4441,13 @@ PP(pp_leavegiven)
     PERL_UNUSED_CONTEXT;
 
     POPBLOCK(cx,newpm);
-    POPGIVEN(cx);
-    assert(CxTYPE(cx) == CXt_GIVEN);
-
     SP = (gimme == G_VOID)
         ? newsp
         : leave_common(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
+    POPGIVEN(cx);
+    assert(CxTYPE(cx) == CXt_GIVEN);
+
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_with_name("given");
@@ -5028,12 +5029,12 @@ PP(pp_leavewhen)
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
-    POPWHEN(cx);
-
     SP = (gimme == G_VOID)
         ? newsp
         : leave_common(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
+    POPWHEN(cx);
+
     PL_curpm = newpm;   /* pop $1 et al */
 
     LEAVE_with_name("when");