Scalar keys assignment through lvalue subs

This used not to work:

   sub foo :lvalue { keys %wallet }
   foo = 37;

Now it does. It was just a matter of following the right code path in
op_lvalue when the parent op is a leavesublv instead of a sassign.

diff --git a/op.c b/op.c
index ecbf4c5..b91f322 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1681,7 +1681,7 @@ Perl_op_lvalue(pTHX_ OP *o, I32 type)
 
     case OP_KEYS:
     case OP_RKEYS:
-       if (type != OP_SASSIGN)
+       if (type != OP_SASSIGN && type != OP_LEAVESUBLV)
            goto nomod;
        goto lvalue_func;
     case OP_SUBSTR:
@@ -1690,9 +1690,9 @@ Perl_op_lvalue(pTHX_ OP *o, I32 type)
        /* FALL THROUGH */
     case OP_POS:
     case OP_VEC:
+      lvalue_func:
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
-      lvalue_func:
        pad_free(o->op_targ);
        o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
        assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 9994b52..98abe96 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -707,6 +707,11 @@ thing returned from the subroutine (but not for C<$scalar, @array> or
 hashes being returned).  Now a more general fix has been applied
 [RT #23790].
 
+=item *
+
+Assignment to C<keys> returned from an lvalue sub used not to work, but now
+it does.
+
 =back
 
 =item *

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index a9ff88b..321f546 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=>155;
+plan tests=>156;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -450,6 +450,11 @@ while (/f/g) {
 }
 is("@p", "1 8");
 
+sub keeze : lvalue { keys %__ }
+%__ = ("a","b");
+keeze = 64;
+is scalar %__, '1/64', 'keys assignment through lvalue sub';
+
 # Bug 20001223.002: split thought that the list had only one element
 @ary = qw(4 5 6);
 sub lval1 : lvalue { $ary[0]; }