Fix a misoptimization when assignig a list in a list context

This commit is contained in:
Petr Písař 2020-08-27 13:37:17 +02:00
parent f3e6b9d3f0
commit 212e2739b3
2 changed files with 83 additions and 0 deletions

View File

@ -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

View File

@ -217,6 +217,10 @@ Patch29: perl-5.33.0-IO-Handle-Fix-a-spurious-error-reported-for-regular-
# in upstream after 5.33.0 # in upstream after 5.33.0
Patch30: perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch 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 # 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 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 %patch28 -p1
%patch29 -p1 %patch29 -p1
%patch30 -p1 %patch30 -p1
%patch31 -p1
%patch200 -p1 %patch200 -p1
%patch201 -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 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 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 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 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' \ 'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil} %{nil}
@ -6986,6 +6992,7 @@ popd
%changelog %changelog
* Thu Aug 27 2020 Petr Pisar <ppisar@redhat.com> - 4:5.32.0-462 * 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 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 * Fri Aug 21 2020 Jeff Law <law@redhat.com> - 4:5.32.0-461
- Re-enable LTO - Re-enable LTO