From 5b354d2a8a6fea46c62048464c6722560cb1c907 Mon Sep 17 00:00:00 2001 From: David Mitchell 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ř --- 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