Make \($x,$y) assignment work

This applies to \ with multiple kids (refgen).  Up till now,
op_lvalue_flags only handled srefgen (single refgen).

Before I was converting srefgen to lvref and nulling the kid op:

  srefgen
    ex-list
      rv2sv
        gv

became:

  lvref
    ex-list
      ex-rv2sv
        gv

Now I’m converting the kid instead and nulling the srefgen:

  ex-srefgen
    ex-list
      lvref
        gv

so that the same code can apply to refgen:

  refgen
    ex-list
      pushmark
      rv2sv
        gv
      rv2sv
        gv

becomes

  ex-refgen
    ex-list
      ex-pushmark
      lvref
        gv
      lvref
        gv

3 files changed, 26 insertions, 21 deletions

diff --git a/op.c b/op.c
index 36b6a924f9..06f442fa1d 100644
--- a/op.c
+++ b/op.c
@@ -2632,20 +2632,23 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
     case OP_SREFGEN:
 	if (type != OP_AASSIGN) goto nomod;
 	kid = cUNOPx(cUNOPo->op_first)->op_first;
-	switch (kid->op_type) {
-	case OP_RV2SV:
+	assert (!OP_HAS_SIBLING(kid));
+	goto kid_2lvref;
+    case OP_REFGEN:
+	if (type != OP_AASSIGN) goto nomod;
+	kid = OP_SIBLING(cUNOPx(cUNOPo->op_first)->op_first);
+	do {
+	 kid_2lvref:
+	  switch (kid->op_type) {
+	  case OP_RV2SV:
 	    if (kUNOP->op_first->op_type != OP_GV) goto badref;
 	    if (kid->op_private & OPpLVAL_INTRO)
 		goto badref; /* XXX temporary */
-	    o->op_flags |= OPf_STACKED;
-	    break;
-	case OP_PADSV:
-	    o->op_private = kid->op_private & OPpLVAL_INTRO;
-	    o->op_targ = kid->op_targ;
-	    kid->op_targ = 0;
+	    kid->op_flags |= OPf_STACKED;
+	  case OP_PADSV:
 	    break;
-	default:
-	  badref:
+	  default:
+	   badref:
 	    /* diag_listed_as: Can't modify %s in %s */
 	    yyerror(Perl_form(aTHX_ "Can't modify reference to %s in list "
 				    "assignment",
@@ -2653,14 +2656,18 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 		      ? "do block"
 		      : OP_DESC(kid)));
 	    return o;
-	}
+	  }
+	  kid->op_type = OP_LVREF;
+	  kid->op_ppaddr = PL_ppaddr[OP_LVREF];
+	  kid->op_private &= OPpLVAL_INTRO;
+	} while ((kid = OP_SIBLING(kid)));
 	if (!FEATURE_LVREF_IS_ENABLED)
 	    Perl_croak(aTHX_ "Experimental lvalue references not enabled");
 	Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
 			      "Lvalue references are experimental");
-	op_null(kid);
-	o->op_type = OP_LVREF;
-	o->op_ppaddr = PL_ppaddr[OP_LVREF];
+	if (o->op_type == OP_REFGEN)
+	    op_null(cUNOPx(cUNOPo->op_first)->op_first); /* pushmark */
+	op_null(o);
 	return o;
     }
 
@@ -5743,7 +5750,7 @@ S_assignment_type(pTHX_ const OP *o)
     if (type == OP_LIST || flags & OPf_PARENS ||
 	type == OP_RV2AV || type == OP_RV2HV ||
 	type == OP_ASLICE || type == OP_HSLICE ||
-        type == OP_KVASLICE || type == OP_KVHSLICE)
+        type == OP_KVASLICE || type == OP_KVHSLICE || type == OP_REFGEN)
 	return TRUE;
 
     if (type == OP_PADAV || type == OP_PADHV)
diff --git a/t/op/lvref.t b/t/op/lvref.t
index be97fb489a..8d9486c78f 100644
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -61,11 +61,9 @@ is \$p, \$_, '\(my $lexical) = ... gives list cx';
 is \$r, \$_, '(\my $lexical) = ... gives list cx';
 \my($s) = @_;
 is \$s, \$_, '\my($lexical) = ... gives list cx';
-on;
-eval '\($_a, my $a) = @{[\$b, \$c]}';
+\($_a, my $a) = @{[\$b, \$c]};
 is \$_a, \$b, 'package scalar in \(...)';
 is \$a, \$c, 'lex scalar in \(...)';
-off;
 (\$_b, \my $b) = @{[\$b, \$c]};
 is \$_b, \$::b, 'package scalar in (\$foo, \$bar)';
 is \$b, \$c, 'lex scalar in (\$foo, \$bar)';
@@ -170,12 +168,10 @@ eval '(\pos) = 42';
 like $@,
      qr/^Can't modify reference to match position in list assignment at /,
     "Can't modify ref to some scalar-returning op in list assignment";
-on;
 eval '(\glob) = 42';
 like $@,
      qr/^Can't modify reference to glob in list assignment at /,
     "Can't modify reference to some list-returning op in list assignment";
-off;
 eval '\pos = 42';
 like $@,
     qr/^Can't modify reference to match position in scalar assignment at /,
diff --git a/t/op/ref.t b/t/op/ref.t
index 8c9e3fd302..dbd532271c 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -319,8 +319,10 @@ is (scalar grep(ref($_), @baa), 3);
 is (scalar (@bzz), 3);
 
 # also, it can't be an lvalue
+# (That’s what *you* think!  --sprout)
 eval '\\($x, $y) = (1, 2);';
-like ($@, qr/Can\'t modify.*ref.*in.*assignment/);
+like ($@, qr/Can\'t modify.*ref.*in.*assignment(?x:
+           )|Experimental lvalue references not enabled/);
 
 # test for proper destruction of lexical objects
 $test = curr_test();