Fix a misoptimization when assignig a list in a list context

perl-5.33.0-list-assign-in-list-context-was-over-optimising.patch

@@ -0,0 +1,76 @@
+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
+

perl.spec

@@ -217,6 +217,10 @@ Patch29:        perl-5.33.0-IO-Handle-Fix-a-spurious-error-reported-for-regular-
 # in upstream after 5.33.0
 Patch30:        perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch
 
+# Fix a misoptimization when assignig a list in a list context, GH#17816,
+# in upstream after 5.33.0
+Patch31:        perl-5.33.0-list-assign-in-list-context-was-over-optimising.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -4234,6 +4238,7 @@ you're not running VMS, this module does nothing.
 %patch28 -p1
 %patch29 -p1
 %patch30 -p1
+%patch31 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -4271,6 +4276,7 @@ perl -x patchlevel.h \
     'Fedora Patch28: Fix a number of arguments passed to a BOOT XS subroutine (GH#17755)' \
     'Fedora Patch29: Fix an IO::Handle spurious error reported for regular file handles (GH#18019)' \
     'Fedora Patch30: Fix inheritance resolution of lexial objects in a debugger (GH#17661)' \
+    'Fedora Patch31: Fix a misoptimization when assignig a list in a list context (GH#17816)' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -6986,6 +6992,7 @@ popd
 %changelog
 * Thu Aug 27 2020 Petr Pisar <ppisar@redhat.com> - 4:5.32.0-462
 - Fix inheritance resolution of lexial objects in a debugger (GH#17661)
+- Fix a misoptimization when assignig a list in a list context (GH#17816)
 
 * Fri Aug 21 2020 Jeff Law <law@redhat.com> - 4:5.32.0-461
 - Re-enable LTO