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.

diff --git a/op.c b/op.c
index 7dcaa3d..812341d 100644 (file)
--- 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 357c8a4..21ef319 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=>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);