Copy keys for aassign in lvalue sub

Checking LVRET (which pp_aassign does, as of a few commits ago)
has no effect if OPpMAYBE_LVSUB is not set on the op.  This com-
mit changes op.c:op_lvalue_flags to set this flag on aassign ops.

This makes sub:lvalue{%h=($x,$x)} behave correctly if the return
values of the sub are assigned to ($x is unmodfied).

diff --git a/dump.c b/dump.c
index 9d5811c..c802732 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -778,7 +778,6 @@ const struct flag_to_name op_sassign_names[] = {
        {(flag), (name)} \
     }
 
-OP_PRIVATE_ONCE(op_aassign, OPpASSIGN_COMMON, ",COMMON");
 OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
 OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
 OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
@@ -801,7 +800,6 @@ const struct op_private_by_op op_private_names[] = {
     {OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
     {OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
     {OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
-    {OP_AASSIGN, C_ARRAY_LENGTH(op_aassign_names), op_aassign_names },
     {OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
     {OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
     {OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
@@ -940,6 +938,12 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
             if (oppriv & OPpFT_AFTER_t)                                 \
                 sv_catpv(tmpsv, ",AFTER_t");                            \
        }                                                               \
+       else if (o->op_type == OP_AASSIGN) {                            \
+           if (oppriv & OPpASSIGN_COMMON)                              \
+               sv_catpvs(tmpsv, ",COMMON");                            \
+           if (oppriv & OPpMAYBE_LVSUB)                                \
+               sv_catpvs(tmpsv, ",MAYBE_LVSUB");                       \
+       }                                                               \
        if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO)            \
            sv_catpv(tmpsv, ",INTRO");                                  \
        if (o->op_type == OP_PADRANGE)                                  \

diff --git a/op.c b/op.c
index fd114b1..60184b6 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2071,11 +2071,12 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        /* FALL THROUGH */
     case OP_ASLICE:
     case OP_HSLICE:
-       if (type == OP_LEAVESUBLV)
-           o->op_private |= OPpMAYBE_LVSUB;
        localize = 1;
        /* FALL THROUGH */
     case OP_AASSIGN:
+       if (type == OP_LEAVESUBLV)
+           o->op_private |= OPpMAYBE_LVSUB;
+       /* FALL THROUGH */
     case OP_NEXTSTATE:
     case OP_DBSTATE:
        PL_modcount = RETURN_UNLIMITED_NUMBER;

diff --git a/t/op/hashassign.t b/t/op/hashassign.t
index 73d8307..365439e 100644 (file)
--- a/t/op/hashassign.t
+++ b/t/op/hashassign.t
@@ -8,7 +8,7 @@ BEGIN {
 
 # use strict;
 
-plan tests => 308;
+plan tests => 309;
 
 my @comma = ("key", "value");
 
@@ -513,6 +513,12 @@ SKIP: {
     $_++ foreach %h = ($x,$x);
     is($x, 0, "returned values are not aliased to RHS of the assignment operation");
 
+    %h = ();
+    $x = 0;
+    $_++ foreach sub :lvalue { %h = ($x,$x) }->();
+    is($x, 0,
+     "returned values are not aliased to RHS of assignment in lvalue sub");
+
     $_++ foreach ($x,$y,%h,$z) = (0);
     ok( eq_array([$x,$y,%h,$z], [1,undef,undef]), "only assigned values are returned" );