[perl #62498] Scalar context breaks lvalue subs

That RT ticket reported that a $ prototype puts an implicit scalar()
on its argument, and that scalar(lvalue()) causes the function to
return a temporary value. In particular:

  ${\scalar($_)} = 1; # ok
  ${\scalar f()} = 1; # no effect

(where f is an lvalue sub that returns $_).

It turns out that this does not only affect scalar(), but also
|| and &&:

  ${\($_  && undef)} = 3; # ok
  ${\(f() && undef)} = 3; # no effect

Also, that comment in pp_leavesublv about f()->meth() not being lvalue
context is wrong, as

  $o->${\sub { $_[0] = "whatever" }};

assigns to $o, and

  sub UNIVERSAL::undef { undef $_[0] }

allows calls like

  $x->undef

to undefine $x, if it contains an object or package name.

Since copying values in rvalue context is wasteful anyway, since the
definition of rvalue context is that the value is going to be copied
(resulting in *two* copies), the easiest solution is not to copy val-
ues in rvalue context.

This ends up applying to what I call ‘reference’ context (semi-lvalue,
or potential lvalue) as well.

This works already with explicit return.

As a bonus, this also fixes bug #78680, for which there are already
to-do tests that were added before the bug was reported. See also:

http://www.nntp.perl.org/group/perl.perl5.porters/;msgid=20060118203058.GQ616@plum.flirble.org

1 files changed, 6 insertions, 23 deletions

diff --git a/pp_hot.c b/pp_hot.c
index 9dffb988ff..ac915b44c7 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2673,10 +2673,9 @@ PP(pp_leavesublv)
 	 * subroutines too, so be backward compatible:
 	 * cannot report errors.  */
 
-	/* Scalar context *is* possible, on the LHS of -> only,
-	 * as in f()->meth().  But this is not an lvalue. */
+	/* Scalar context *is* possible, on the LHS of ->. */
 	if (gimme == G_SCALAR)
-	    goto temporise;
+	    goto rvalue;
 	if (gimme == G_ARRAY) {
 	    mark = newsp + 1;
 	    /* We want an array here, but padav will have left us an arrayref for an lvalue,
@@ -2702,7 +2701,7 @@ PP(pp_leavesublv)
 		PUTBACK;
 	    }
 	    if (!CvLVALUE(cx->blk_sub.cv))
-		goto temporise_array;
+		goto rvalue_array;
 	    EXTEND_MORTAL(SP - newsp);
 	    for (mark = newsp + 1; mark <= SP; mark++) {
 		if (SvTEMP(*mark))
@@ -2801,24 +2800,16 @@ PP(pp_leavesublv)
     }
     else {
 	if (gimme == G_SCALAR) {
-	  temporise:
+	  rvalue:
 	    MARK = newsp + 1;
 	    if (MARK <= SP) {
 		if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-		    if (SvTEMP(TOPs)) {
 			*MARK = SvREFCNT_inc(TOPs);
 			FREETMPS;
 			sv_2mortal(*MARK);
-		    }
-		    else {
-			sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
-			FREETMPS;
-			*MARK = sv_mortalcopy(sv);
-			SvREFCNT_dec(sv);
-		    }
 		}
 		else
-		    *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
+		    *MARK = TOPs;
 	    }
 	    else {
 		MEXTEND(MARK, 0);
@@ -2826,16 +2817,8 @@ PP(pp_leavesublv)
 	    }
 	    SP = MARK;
 	}
-	else if (gimme == G_ARRAY) {
-	  temporise_array:
-	    for (MARK = newsp + 1; MARK <= SP; MARK++) {
-		if (!SvTEMP(*MARK)) {
-		    *MARK = sv_mortalcopy(*MARK);
-		    TAINT_NOT;  /* Each item is independent */
-		}
-	    }
-	}
     }
+  rvalue_array:
     PUTBACK;
 
     LEAVE;