From 5b354d2a8a6fea46c62048464c6722560cb1c907 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 11 Aug 2020 11:55:46 +0100
Subject: [PATCH] list assign in list context was over-optimising
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

GH #17816

This code:

    my $x = 1;
    print (($x, undef) = (2 => $x));

was printing "22" when it should have been printing "21".
An optimisation skips the 'common values on both sides' test
when the LHS of an assign only contains a single var; as the example
above shows, this is not sufficient.

This was broken by v5.23.1-202-g808ce55782

This commit fixes it by counting undef's on the LHS towards the var
count if they don't appear first.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 op.c           | 10 +++++++---
 t/op/aassign.t | 10 ++++++++++
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/op.c b/op.c
index 05f6d9d1a3..49aac853d4 100644
--- a/op.c
+++ b/op.c
@@ -15679,11 +15679,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, int *scalars_p)
         goto do_next;
 
     case OP_UNDEF:
-        /* undef counts as a scalar on the RHS:
-         *   (undef, $x) = ...;         # only 1 scalar on LHS: always safe
+        /* undef on LHS following a var is significant, e.g.
+         *    my $x = 1;
+         *    @a = (($x, undef) = (2 => $x));
+         *    # @a shoul be (2,1) not (2,2)
+         *
+         * undef on RHS counts as a scalar:
          *   ($x, $y)    = (undef, $x); # 2 scalars on RHS: unsafe
          */
-        if (rhs)
+        if ((!rhs && *scalars_p) || rhs)
             (*scalars_p)++;
         flags = AAS_SAFE_SCALAR;
         break;
diff --git a/t/op/aassign.t b/t/op/aassign.t
index ed904adc62..9128f9fd98 100644
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -594,4 +594,14 @@ SKIP: {
     is ($fill, 2, "RT #130132 array 2");
 }
 
+{
+    # GH #17816
+    # don't use the "1-arg on LHS can't be common" optimisation
+    # when there are undef's there
+    my $x = 1;
+    my @a = (($x, undef) = (2 => $x));
+    is("@a", "2 1", "GH #17816");
+}
+
+
 done_testing();
-- 
2.25.4