pp_return(): tail call pp_leavewrite()

When 'return'ing from a format, rather than handling it ourselves, fall
through to pp_leavewrite(). pp_return() is now only responsible for
popping any extra contexts and junk from the stack.

With this commit, *all* types of return are now handled by tail-calling
the appropriate pp_leaveFOO() function, so this commit also cuts out big
chunks of dead code.

Note that the behaviour on using 'return' in a format is completely
undocumented, and almost completely untested. In fact there is only a
single format in the test suite that does a return, and the tests which
use that are mainly there to ensure that extra stuff on the stack doesn't
leak into the value(s) returned by write().

In particular, its not clear whether a return half-way through a format
should cause the lines processed so far to be output, or to be discarded;
currently it discards. Also, its not clear what (if anything) should be
done with any args to the 'return' call. Currently they're just discarded.
Also, the format in the test suite which does a return only does a
'return;', not a 'return x,y,z'. So that's still untested.

So I decided to keep the current behaviour of return in format as close
as possible rather than trying to change of fix anything.

1 files changed, 11 insertions, 37 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 97ae093f09..37f505acad 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2417,10 +2417,7 @@ PP(pp_return)
 {
     dSP; dMARK;
     PERL_CONTEXT *cx;
-    I32 gimme;
-    SV **newsp;
-    PMOP *newpm;
-    OP *retop = NULL;
+    SV **oldsp;
 
     const I32 cxix = dopoptosub(cxstack_ix);
 
@@ -2445,10 +2442,7 @@ PP(pp_return)
 
     cx = &cxstack[cxix];
 
-    if (CxTYPE(cx) == CXt_SUB
-        || (CxTYPE(cx) == CXt_EVAL))
-    {
-        SV **oldsp = PL_stack_base + cx->blk_oldsp;
+        oldsp = PL_stack_base + cx->blk_oldsp;
         if (oldsp != MARK) {
             /* Handle extra junk on the stack. For example,
              *    for (1,2) { return 3,4 }
@@ -2472,42 +2466,22 @@ PP(pp_return)
             else
                 PL_stack_sp  = oldsp;
         }
-        if (CxTYPE(cx) == CXt_EVAL)
-            return CxTRYBLOCK(cx)
-                ? Perl_pp_leavetry(aTHX)
-                : Perl_pp_leaveeval(aTHX);
-        /* fall through to a normal sub exit */
+
+    /* fall through to a normal exit */
+    switch (CxTYPE(cx)) {
+    case CXt_EVAL:
+        return CxTRYBLOCK(cx)
+            ? Perl_pp_leavetry(aTHX)
+            : Perl_pp_leaveeval(aTHX);
+    case CXt_SUB:
         return CvLVALUE(cx->blk_sub.cv)
             ? Perl_pp_leavesublv(aTHX)
             : Perl_pp_leavesub(aTHX);
-    }
-
-    POPBLOCK(cx,newpm);
-    switch (CxTYPE(cx)) {
     case CXt_FORMAT:
-	retop = cx->blk_sub.retop;
-	POPFORMAT(cx);
-	break;
+        return Perl_pp_leavewrite(aTHX);
     default:
 	DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
     }
-
-    TAINT_NOT;
-    if (gimme == G_SCALAR)
-        *++newsp = (MARK < SP) ? sv_mortalcopy(*SP) : &PL_sv_undef;
-    else if (gimme == G_ARRAY) {
-        while (++MARK <= SP) {
-            *++newsp = sv_mortalcopy(*MARK);
-            TAINT_NOT;		/* Each item is independent */
-        }
-    }
-    PL_stack_sp = newsp;
-
-    LEAVE;
-
-    PL_curpm = newpm;	/* ... and pop $1 et al */
-
-    return retop;
 }