X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c08f093b3e154c428f604f89f7feb633e6c97869..a7fa83459a57b807d31dd217c012d13355deb026:/pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 9eb2814..854c89d 100644
--- 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;
 }