diff options
| -rw-r--r-- | pp_hot.c | 29 | ||||
| -rw-r--r-- | t/op/sub_lval.t | 27 | ||||
| -rw-r--r-- | t/re/pat_rt_report.t | 5 |
3 files changed, 34 insertions, 27 deletions
@@ -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; diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index 5db41800b4..f490ec4261 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -3,7 +3,7 @@ BEGIN { @INC = '../lib'; require './test.pl'; } -plan tests=>108; +plan tests=>124; sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary sub b : lvalue { ${\shift} } @@ -684,3 +684,28 @@ like $@, qr/Can\'t return a readonly value from lvalue subroutine at/, eval { (sub :lvalue { 3 }->()) = 4 }; like $@, qr/Can\'t return a readonly value from lvalue subroutine at/, 'assignment to num constant implicitly returned (list cx)'; + +# reference (potential lvalue) context +$suffix = ''; +for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) { + &$sub()->${\sub { $_[0] = 37 }}; + is $_, '37', 'lvalue->method'.$suffix; + ${\scalar &$sub()} = 38; + is $_, '38', 'scalar(lvalue)'.$suffix; + sub assign39_with_proto ($) { $_[0] = 39 } + assign39_with_proto(&$sub()); + is $_, '39', 'func(lvalue) when func has $ proto'.$suffix; + $_ = 1; + ${\(&$sub()||undef)} = 40; + is $_, '40', 'lvalue||...'.$suffix; + ${\(${\undef}||&$sub())} = 41; # extra ${\...} to bypass const folding + is $_, '41', '...||lvalue'.$suffix; + $_ = 0; + ${\(&$sub()&&undef)} = 42; + is $_, '42', 'lvalue&&...'.$suffix; + ${\(${\1}&&&$sub())} = 43; + is $_, '43', '...&&lvalue'.$suffix; + ${\(&$sub())[0]} = 44; + is $_, '44', '(lvalue)[0]'.$suffix; +} +continue { $suffix = ' (explicit return)' } diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t index 7a03e6440a..781a6da615 100644 --- a/t/re/pat_rt_report.t +++ b/t/re/pat_rt_report.t @@ -534,7 +534,8 @@ sub run_tests { } { - local $::TODO = "See changes 26925-26928, which reverted change 26410"; + # [perl #78680] + # See changes 26925-26928, which reverted change 26410 { package lv; our $var = "abc"; @@ -552,7 +553,6 @@ sub run_tests { is($f, "ab", "pos() retained between calls"); } else { - local $::TODO; ok 0, "Code failed: $@"; } @@ -569,7 +569,6 @@ sub run_tests { is($g, "ab", "pos() retained between calls"); } else { - local $::TODO; ok 0, "Code failed: $@"; } } |