[perl #92290, #92406] Returning a pad var from lv sub

This fixes a recent (post-5.14.0) regression.

Commit bf8fb5e (the fix for #62498) introduced it for lvalue subs with
no return statement [perl #92406].
Commit fa1e92c (the fix for #72724) introduced it for lvalue subs that
do have an explicit return [perl #92290].

Simply returning a scalar itself from an lvalue sub does not work if
it is a pad variable with a reference count of 1.  In that circum-
stance, the sub-popping code sees that the SV can be re-used the next
time the sub is called, so it undefines it and hangs on to it.  So
the scalar returned gets emptied before the calling code can see it.

The reference count has to be increased temporarily, which sv_2mortal
and SvREFCNT_inc combined accomplish.

diff --git a/pp_ctl.c b/pp_ctl.c
index eed88f8..868ef01 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2227,7 +2227,11 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                        sv_2mortal(*newsp);
                }
                else
-                   *++newsp = *SP;
+                   *++newsp =
+                       (!CxLVAL(cx) || CxLVAL(cx) & OPpENTERSUB_INARGS) &&
+                       !SvTEMP(*SP)
+                         ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
+                         : *SP;
        }
        else
            *++newsp = &PL_sv_undef;
@@ -2249,7 +2253,13 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
     }
     else if (gimme == G_ARRAY) {
        assert (!(CxLVAL(cx) & OPpENTERSUB_DEREF));
-       while (++MARK <= SP) {
+       if (!CxLVAL(cx) || CxLVAL(cx) & OPpENTERSUB_INARGS)
+           while (++MARK <= SP)
+               *++newsp =
+                    SvTEMP(*MARK)
+                      ? *MARK
+                      : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
+       else while (++MARK <= SP) {
            *++newsp = *MARK;
            TAINT_NOT;          /* Each item is independent */
        }

diff --git a/pp_hot.c b/pp_hot.c
index cd556f3..8d02826 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2802,7 +2802,9 @@ PP(pp_leavesublv)
                        sv_2mortal(*MARK);
                }
                else
-                   *MARK = TOPs;
+                   *MARK = SvTEMP(TOPs)
+                             ? TOPs
+                             : sv_2mortal(SvREFCNT_inc_simple_NN(TOPs));
            }
            else {
                MEXTEND(MARK, 0);
@@ -2810,6 +2812,13 @@ PP(pp_leavesublv)
            }
            SP = MARK;
        }
+       else if (gimme == G_ARRAY) {
+         rvalue_array:
+           for (MARK = newsp + 1; MARK <= SP; MARK++) {
+               if (!SvTEMP(*MARK))
+                   *MARK = sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
+           }
+       }
     }
 
     if (CxLVAL(cx) & OPpENTERSUB_DEREF) {
@@ -2829,7 +2838,6 @@ PP(pp_leavesublv)
        }
     }
 
-  rvalue_array:
     PUTBACK;
 
     LEAVE;

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index de4a8cc..a9ff88b 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=>151;
+plan tests=>155;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -786,3 +786,14 @@ for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) {
     is join('-',%$_), '4-5', '%{func()} autovivification'.$suffix;
 }
 continue { $suffix = ' (explicit return)' }
+
+# [perl #92406] [perl #92290] Returning a pad var in rvalue context
+$suffix = '';
+for my $sub (
+         sub :lvalue { my $x = 72; $x },
+         sub :lvalue { my $x = 72; return $x }
+) {
+    is scalar(&$sub), 72, "sub returning pad var in scalar context$suffix";
+    is +(&$sub)[0], 72, "sub returning pad var in list context$suffix";
+}
+continue { $suffix = ' (explicit return)' }