Allow lvalue subs to return TEMPs

This is perhaps not ideal, but it fixes (or allows to be fixed) seve-
ral bugs.

I was hoping that the cases that this perhaps erroneously allows
through would fall back to the warning I added in commit 8fe85e3, but,
unfortunately, in all these cases the refcount is greater than 1 when
pp_sassign is reached.

To be less vague: ‘foo() = 3’ warns if foo() returns a TEMP with no
set-magic and a refcount of 1 (meaning it will be freed shortly). But
truly temporary values returned by pure-Perl lvalue subs have a refer-
ence count of at least 2, and as many entries on the mortals stack.

I cannot distinguish between truly temporary values and those that
are but nominally temporary (marked TEMP because the refcount will go
down, but not to zero) by checking for a refcount <= 2 in pp_sassign,
because this example returns with a refcount of 2:

+sub :lvalue { return delete($_[0]), $x }->($x) = 3; # returns a TEMP

There’s no logical reason why that shouldn’t work, if this does:

+sub :lvalue { return foo(), $x }->($x) = 3; # not TEMP

as they are conceptually identical.

The advantages to this change:

• The delete example above will work.
• It allows XS lvalue subs that return TEMPs to work in the debugger
  [perl #71172], restoring the bug fix that b724cc1 implemented but
  c73030b reverted.
• It makes these three cases identical, as they should be. Note that
  only two of them return TEMPs:
    +sub :lvalue { return shift }->($x) = 3;
    +sub :lvalue { \@_; return shift }->($x) = 3; # returns a TEMP
    +sub :lvalue { return delete $_[0] }->($x) = 3; # returns a TEMP

So I think the advantages outweigh the disadvantages.

diff --git a/pp_hot.c b/pp_hot.c
index 3bafefb..2525a26 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2725,9 +2725,7 @@ PP(pp_leavesublv)
            MARK = newsp + 1;
            EXTEND_MORTAL(1);
            if (MARK == SP) {
-               /* Temporaries are bad unless they happen to have set magic
-                * attached, such as the elements of a tied hash or array */
-               if ((SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP) ||
+               if ((SvPADTMP(TOPs) ||
                     (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
                       == SVf_READONLY
                    ) &&
@@ -2762,7 +2760,7 @@ PP(pp_leavesublv)
            EXTEND_MORTAL(SP - newsp);
            for (mark = newsp + 1; mark <= SP; mark++) {
                if (*mark != &PL_sv_undef
-                   && (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP)
+                   && (SvPADTMP(*mark)
                       || (SvFLAGS(*mark) & (SVf_READONLY|SVf_FAKE))
                             == SVf_READONLY
                       )

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index 9990fb8..818dc60 100644 (file)
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>99;
+plan tests=>100;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -289,7 +289,15 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t return a temporary from lvalue subroutine/);
+is($_, undef, "returning a temp from an lvalue sub in list context");
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1tmp = 3;
+  1;
+EOE
+
+is($_, undef, "returning a temp from an lvalue sub in scalar context");
 
 sub yyy () { 'yyy' } # Const, not lvalue