summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Leach <richardleach@users.noreply.github.com>2022-08-22 13:47:46 +0000
committerRichard Leach <richardleach@users.noreply.github.com>2022-08-23 10:36:09 +0100
commit6f629715866f9fa9452688fb66ee6661307b7a78 (patch)
tree66a61ffed29b5e35855c67ce384f2a06f74cc4d9
parentbded974f30650c2002b7abfdf8555531ecbfac81 (diff)
downloadperl-6f629715866f9fa9452688fb66ee6661307b7a78.tar.gz
rpeep: don't apply padsv_store and padrange together
As originally committed, the OP_PADSV_STORE optimization interacted negatively with OP_PADRANGE: 1. The new rpeep code was buggy, as it assumed that oldop must be the targ PADSV, when it could have been a padrange. In the first case, updating `oldoldop->op_next = o` is correct, in the second case the op_next chain must be left as-is. That was easily fixable. 2. There was some problem with stack book-keeping - probably of the mark stack. The following test case continued to fail even after the rpeep code had been fixed: my $x = {}; my $y; print keys %{$y = $x}; However, since both OP_PADSV_STORE and OP_PADRANGE optimize by taking the targ PADSV out of the op_next chain, it was apparent that there is reduced gain from having both optimizations applied to the same optree. Therefore, the simple fix applied by this commit is to modify peep(), such that the OP_PADSV_STORE optimization is not applied when OP_PADRANGE has already been applied. Existing tests did not pick up the problems, which were identified via Blead-Breaks-CPAN reports. Additional tests have thus been included.
-rw-r--r--peep.c3
-rw-r--r--t/op/lex_assign.t29
2 files changed, 32 insertions, 0 deletions
diff --git a/peep.c b/peep.c
index ec89797205..d7e618d0c0 100644
--- a/peep.c
+++ b/peep.c
@@ -3854,6 +3854,8 @@ Perl_rpeep(pTHX_ OP *o)
if (!(o->op_private & (OPpASSIGN_BACKWARDS|OPpASSIGN_CV_TO_GV))
&& lval && (lval->op_type == OP_PADSV) &&
!(lval->op_private & OPpDEREF)
+ /* skip if padrange has already gazumped the padsv */
+ && (lval == oldop)
) {
/* SASSIGN's bitfield flags, such as op_moresib and
@@ -3876,6 +3878,7 @@ Perl_rpeep(pTHX_ OP *o)
o->op_targ = lval->op_targ; lval->op_targ = 0;
/* Fixup op_next ptrs */
+ assert(oldop->op_type == OP_PADSV);
/* oldoldop can be arbitrarily deep in the RHS OP tree */
oldoldop->op_next = o;
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
index 6635d888e2..1f97d3988d 100644
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -227,6 +227,35 @@ is($@, '', 'ex-PVBM assert'.$@);
cmp_ok($diff, '<', 2, "time delta is small");
}
+# GH #20132 and parts of GH ##20114
+# During development of OP_PADSV_STORE, interactions with OP_PADRANGE
+# caused BBC failures not picked up by any pre-existing core tests.
+# (Problems only arose in list context, the void/scalar tests have been
+# included for completeness.)
+eval {
+ my $x = {}; my $y;
+ keys %{$y = $x};
+ 1;
+};
+is($@, '', 'keys %{$y = $x}');
+
+eval {
+ my $x = {}; my $y;
+ my $foo = keys %{$y = $x};
+ 1;
+};
+is($@, '', 'my $foo = keys %{$y = $x}');
+
+eval {
+ my $x = {}; my $y;
+ my @foo = keys %{$y = $x};
+ 1;
+};
+is($@, '', 'my @foo = keys %{$y = $x}');
+
+fresh_perl_is('my ($x, $y); (($y = $x))', '', {}, '(($y = $x))');
+fresh_perl_is('my ($x, $y); my $z= (($y = $x))', '', {}, 'my $z= (($y = $x))');
+fresh_perl_is('my ($x, $y); my @z= (($y = $x))', '', {}, 'my @z= (($y = $x))');
done_testing();