77 lines
2.1 KiB
Diff
77 lines
2.1 KiB
Diff
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
|
|
|