diff options
author | Father Chrysostomos <sprout@cpan.org> | 2013-10-24 10:53:46 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2013-10-24 10:54:27 -0700 |
commit | 32cbae3f95283fbf92f1e0d0d188dbb5d5ad5804 (patch) | |
tree | 66bec29e7de1e1166d2e42bdc018e2bfae5b4fcf | |
parent | a373464fd655c7246cf689f421efc503307b705c (diff) | |
download | perl-32cbae3f95283fbf92f1e0d0d188dbb5d5ad5804.tar.gz |
Restore prev. behaviour of @a||... in lv sub
$ perl5.18.1 -lwe 'my @a; sub i:lvalue {@a||@b} @a=1; (i())=3'
Name "main::b" used only once: possible typo at -e line 1.
Useless assignment to a temporary at -e line 1.
Bleadperl:
$ ./perl -Ilib -lwe 'my @a; sub i:lvalue {@a||@b} @a=1; (i())=3'
Name "main::b" used only once: possible typo at -e line 1.
Can't return array to lvalue scalar context at -e line 1.
I accidentally changed it in commit 2ec7f6f242 by propagating the
lvalue context. This commit changes it back by only flagging the
rv2av op as being in an lvalue sub if it is not already flagged as
being in scalar context.
The old behaviour was inconsistent, and this commit does restore it
(see the tests), but resolving that discrepancy is for a future commit
(if I ever get to it).
In any case, ‘Can't return array to lvalue scalar context’ is wrong.
-rw-r--r-- | op.c | 9 | ||||
-rw-r--r-- | t/op/sub_lval.t | 27 |
2 files changed, 33 insertions, 3 deletions
@@ -2164,7 +2164,11 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) localize = 1; /* FALL THROUGH */ case OP_AASSIGN: - if (type == OP_LEAVESUBLV) + /* Do not apply the lvsub flag for rv2[ah]v in scalar context. */ + if (type == OP_LEAVESUBLV && ( + (o->op_type != OP_RV2AV && o->op_type != OP_RV2HV) + || (o->op_flags & OPf_WANT) != OPf_WANT_SCALAR + )) o->op_private |= OPpMAYBE_LVSUB; /* FALL THROUGH */ case OP_NEXTSTATE: @@ -2208,7 +2212,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) return o; /* Treat \(@foo) like ordinary list. */ if (scalar_mod_type(o, type)) goto nomod; - if (type == OP_LEAVESUBLV) + if ((o->op_flags & OPf_WANT) != OPf_WANT_SCALAR + && type == OP_LEAVESUBLV) o->op_private |= OPpMAYBE_LVSUB; /* FALL THROUGH */ case OP_PADSV: diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index 357c8a4f75..21ef319eb9 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=>203; +plan tests=>205; sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary sub b : lvalue { ${\shift} } @@ -318,6 +318,31 @@ EOE like($_, qr/Can\'t return a temporary from lvalue subroutine/, 'returning a PADTMP explicitly (list context)'); +# These next two tests are not necessarily normative. But this way we will +# know if this discrepancy changes. + +$_ = undef; +eval <<'EOE' or $_ = $@; + sub scalarray : lvalue { @a || $b } + @a = 1; + (scalarray) = (2,3); + 1; +EOE + +like($_, qr/Can\'t return a temporary from lvalue subroutine/, + 'returning a scalar-context array via ||'); + +$_ = undef; +eval <<'EOE' or $_ = $@; + use warnings "FATAL" => "all"; + sub myscalarray : lvalue { my @a = 1; @a || $b } + (myscalarray) = (2,3); + 1; +EOE + +like($_, qr/Useless assignment to a temporary/, + 'returning a scalar-context lexical array via ||'); + $_ = undef; sub lv2t : lvalue { shift } (lv2t($_)) = (2,3); |