summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-10-24 10:53:46 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-10-24 10:54:27 -0700
commit32cbae3f95283fbf92f1e0d0d188dbb5d5ad5804 (patch)
tree66bec29e7de1e1166d2e42bdc018e2bfae5b4fcf
parenta373464fd655c7246cf689f421efc503307b705c (diff)
downloadperl-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.c9
-rw-r--r--t/op/sub_lval.t27
2 files changed, 33 insertions, 3 deletions
diff --git a/op.c b/op.c
index 7dcaa3d2d3..812341d06f 100644
--- a/op.c
+++ b/op.c
@@ -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);