Make lvalue subs copy returned PADTMPs in rvalue cx

I was trying to write a JAPH, but did not get what I expected:

$ ./perl -Ilib -e '@UNIVERSAL::ISA = CORE; print "just another "->ucfirst, "perl hacker,\n"->ucfirst'
Perl hacker,
Perl hacker,

This happened because coresubs use leavesublv, to avoid copying the
return value wastefully.

But since this is exactly the same ucfirst op being called each time
(the one in &CORE::ucfirst’s op tree), and since ucfirst uses TARG, we
end up with the same scalar.

We have the same problem with lvalue subs:

$ ./perl -Ilib -e 'sub UNIVERSAL::ucfirst :lvalue { ucfirst $_[0] } print "just another "->ucfirst, "perl hacker,\n"->ucfirst'
Perl hacker,
Perl hacker,

(This is not a regression, as 5.14 gave ‘Can't modify ucfirst in
lvalue subroutine return’.)

So ‘fixing’ coresubs would not be a solution, but a workaround.

The solution therefore is for leavesublv to copy PADTMPs in
rvalue context.

Commit 80422e24c fixed this for potential lvalue list context (i.e.,
for(lvsub()) {...}), but it wasn’t sufficient.

1 files changed, 15 insertions, 4 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 3aa0204c14..4e54bd35be 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2370,13 +2370,24 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
 	if (MARK < SP) {
 	      copy_sv:
 		if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
+		    if (!SvPADTMP(*SP)) {
 			*++newsp = SvREFCNT_inc(*SP);
 			FREETMPS;
 			sv_2mortal(*newsp);
+		    }
+		    else {
+			/* FREETMPS could clobber it */
+			SV *sv = SvREFCNT_inc(*SP);
+			FREETMPS;
+			*++newsp = sv_mortalcopy(sv);
+			SvREFCNT_dec(sv);
+		    }
 		}
 		else
 		    *++newsp =
-		        !SvTEMP(*SP)
+		      SvPADTMP(*SP)
+		       ? sv_mortalcopy(*SP)
+		       : !SvTEMP(*SP)
 		          ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
 		          : *SP;
 	}
@@ -2396,10 +2407,10 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
 	if (ref || !CxLVAL(cx))
 	    while (++MARK <= SP)
 		*++newsp =
-		     SvTEMP(*MARK)
-		       ? *MARK
-		       : ref && SvFLAGS(*MARK) & SVs_PADTMP
+		       SvFLAGS(*MARK) & SVs_PADTMP
 		           ? sv_mortalcopy(*MARK)
+		     : SvTEMP(*MARK)
+		           ? *MARK
 		           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
 	else while (++MARK <= SP) {
 	    if (*MARK != &PL_sv_undef