Change ValidProtoString() to valid_proto_string()

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 9eb2814..854c89d 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1469,6 +1469,20 @@ Perl_is_lvalue_sub(pTHX)
        return 0;
 }
 
+/* only used by PUSHSUB */
+I32
+Perl_was_lvalue_sub(pTHX)
+{
+    dVAR;
+    const I32 cxix = dopoptosub(cxstack_ix-1);
+    assert(cxix >= 0);  /* We should only be called from inside subs */
+
+    if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
+       return CxLVAL(cxstack + cxix);
+    else
+       return 0;
+}
+
 STATIC I32
 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
 {
@@ -2087,18 +2101,7 @@ PP(pp_enter)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
-    I32 gimme = OP_GIMME(PL_op, -1);
-
-    if (gimme == -1) {
-       if (cxstack_ix >= 0) {
-           /* If this flag is set, we're just inside a return, so we should
-            * store the caller's context */
-           gimme = (PL_op->op_flags & OPf_SPECIAL)
-               ? block_gimme()
-               : cxstack[cxstack_ix].blk_gimme;
-       } else
-           gimme = G_SCALAR;
-    }
+    I32 gimme = GIMME_V;
 
     ENTER_with_name("block");
 
@@ -2307,6 +2310,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
     if (gimme == G_SCALAR) {
        if (CxLVAL(cx) && !ref) {     /* Leave it as it is if we can. */
            SV *sv;
+           const char *what = NULL;
            if (MARK < SP) {
                assert(MARK+1 == SP);
                if ((SvPADTMP(TOPs) ||
@@ -2314,37 +2318,27 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                       == SVf_READONLY
                    ) &&
                    !SvSMAGICAL(TOPs)) {
-                   LEAVE;
-                   cxstack_ix--;
-                   POPSUB(cx,sv);
-                   PL_curpm = newpm;
-                   LEAVESUB(sv);
-                   Perl_croak(aTHX_
-                       "Can't return %s from lvalue subroutine",
+                   what =
                        SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
-                       : "a readonly value" : "a temporary");
-               }
-               else {                  /* Can be a localized value
-                   EXTEND_MORTAL(1);    * subject to deletion. */
-                   PL_tmps_stack[++PL_tmps_ix] = *SP;
-                   SvREFCNT_inc_void(*SP);
-                   *++newsp = *SP;
+                       : "a readonly value" : "a temporary";
                }
+               else goto copy_sv;
            }
            else {
                /* sub:lvalue{} will take us here. */
-               LEAVE;
-               cxstack_ix--;
-               POPSUB(cx,sv);
-               PL_curpm = newpm;
-               LEAVESUB(sv);
-               Perl_croak(aTHX_
-               /* diag_listed_as: Can't return %s from lvalue subroutine*/
-                         "Can't return undef from lvalue subroutine"
-               );
+               what = "undef";
            }
+           LEAVE;
+           cxstack_ix--;
+           POPSUB(cx,sv);
+           PL_curpm = newpm;
+           LEAVESUB(sv);
+           Perl_croak(aTHX_
+                     "Can't return %s from lvalue subroutine", what
+           );
        }
-       else if (MARK < SP) {
+       if (MARK < SP) {
+             copy_sv:
                if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
                        *++newsp = SvREFCNT_inc(*SP);
                        FREETMPS;
@@ -4998,8 +4992,7 @@ PP(pp_leavewhen)
        return cx->blk_loop.my_op->op_nextop;
     }
     else
-       /* RETURNOP calls PUTBACK which restores the old old sp */
-       return cx->blk_givwhen.leave_op;
+       RETURNOP(cx->blk_givwhen.leave_op);
 }
 
 PP(pp_continue)
@@ -5045,7 +5038,9 @@ PP(pp_break)
     if (cxix < cxstack_ix)
         dounwind(cxix);
 
-    /* RETURNOP calls PUTBACK which restores the old old sp */
+    /* Restore the sp at the time we entered the given block */
+    TOPBLOCK(cx);
+
     return cx->blk_givwhen.leave_op;
 }