diff options
author | Richard Leach <richardleach@users.noreply.github.com> | 2022-08-22 13:47:46 +0000 |
---|---|---|
committer | Richard Leach <richardleach@users.noreply.github.com> | 2022-08-23 10:36:09 +0100 |
commit | 6f629715866f9fa9452688fb66ee6661307b7a78 (patch) | |
tree | 66a61ffed29b5e35855c67ce384f2a06f74cc4d9 | |
parent | bded974f30650c2002b7abfdf8555531ecbfac81 (diff) | |
download | perl-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.c | 3 | ||||
-rw-r--r-- | t/op/lex_assign.t | 29 |
2 files changed, 32 insertions, 0 deletions
@@ -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(); |