In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e45d8982aeb58420180a04c6079471d707058965?hp=d320cf40013cb3d9e9458bacdc38048ffba35a6c>
- Log ----------------------------------------------------------------- commit e45d8982aeb58420180a04c6079471d707058965 Author: Matthew Horsfall (alh) <wolfs...@gmail.com> Date: Tue Oct 8 12:56:08 2013 -0400 Optimise 'if ($a || $b)' and 'unless ($a && $b)' early exit An OP_AND/OP_OR in void context provides a short circuit through ->op_other that can be used if AND/OR ops contained within it jump out early. Use that short circuit. Previously: $ ./perl -Ilib -MO=Concise -e 'if ($aa || $bb) {}' 8 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 3 -e:1) v:{ ->3 - <1> null vK/1 ->8 6 <|> and(other->7) vK/1 ->8 - <1> null sK/1 ->6 4 <|> or(other->5) sK/1 ->6 <-- Not optimised - <1> ex-rv2sv sK/1 ->4 3 <$> gvsv(*aa) s ->4 - <1> ex-rv2sv sK/1 ->- 5 <$> gvsv(*bb) s ->6 - <@> scope vK ->- 7 <0> stub v ->8 Now: $ ./perl -Ilib -MO=Concise -e 'if ($aa || $bb) {}' 8 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 3 -e:1) v:{ ->3 - <1> null vK/1 ->8 6 <|> and(other->7) vK/1 ->8 - <1> null sK/1 ->6 4 <|> or(other->5) sK/1 ->7 <-- Short circuited - <1> ex-rv2sv sK/1 ->4 3 <$> gvsv(*aa) s ->4 - <1> ex-rv2sv sK/1 ->- 5 <$> gvsv(*bb) s ->6 - <@> scope vK ->- 7 <0> stub v ->8 ----------------------------------------------------------------------- Summary of changes: op.c | 18 ++++++++++++++++++ t/op/dor.t | 26 +++++++++++++++++++++++++- t/op/or.t | 18 +++++++++++++++++- 3 files changed, 60 insertions(+), 2 deletions(-) diff --git a/op.c b/op.c index 236a6e0..fe6d89e 100644 --- a/op.c +++ b/op.c @@ -11062,6 +11062,9 @@ S_inplace_aassign(pTHX_ OP *o) { defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o; \ } STMT_END +#define IS_AND_OP(o) (o->op_type == OP_AND) +#define IS_OR_OP(o) (o->op_type == OP_OR) + /* A peephole optimizer. We visit the ops in the order they're to execute. * See the comments at the top of this file for more details about when * peep() is called */ @@ -11529,6 +11532,21 @@ Perl_rpeep(pTHX_ OP *o) while (o->op_next && ( o->op_type == o->op_next->op_type || o->op_next->op_type == OP_NULL)) o->op_next = o->op_next->op_next; + + /* if we're an OR and our next is a AND in void context, we'll + follow it's op_other on short circuit, same for reverse. + We can't do this with OP_DOR since if it's true, its return + value is the underlying value which must be evaluated + by the next op */ + if (o->op_next && + ( + (IS_AND_OP(o) && IS_OR_OP(o->op_next)) + || (IS_OR_OP(o) && IS_AND_OP(o->op_next)) + ) + && (o->op_next->op_flags & OPf_WANT) == OPf_WANT_VOID + ) { + o->op_next = ((LOGOP*)o->op_next)->op_other; + } DEFER(cLOGOP->op_other); o->op_opt = 1; diff --git a/t/op/dor.t b/t/op/dor.t index e2385f1..a0b98f1 100644 --- a/t/op/dor.t +++ b/t/op/dor.t @@ -10,7 +10,7 @@ BEGIN { package main; require './test.pl'; -plan( tests => 31 ); +plan( tests => 34 ); my($x); @@ -74,3 +74,27 @@ like( $@, qr/^Search pattern not terminated/, is(0 // 2, 0, ' // : left-hand operand not optimized away'); is('' // 2, '', ' // : left-hand operand not optimized away'); is(undef // 2, 2, ' // : left-hand operand optimized away'); + +# Test that OP_DORs other branch isn't run when arg is defined +# // returns the value if its defined, and we must test its +# truthness after +my $x = 0; +my $y = 0; + +$x // 1 and $y = 1; +is($y, 0, 'y is still 0 after "$x // 1 and $y = 1"'); + +$y = 0; +# $x is defined, so its value 0 is returned to the if block +# and the block is skipped +if ($x // 1) { + $y = 1; +} +is($y, 0, 'if ($x // 1) exited out early since $x is defined and 0'); + +# This is actually (($x // $z) || 'cat'), so 0 from first dor +# evaluates false, we should see 'cat'. +$y = undef; + +$y = $x // $z || 'cat'; +is($y, 'cat', 'chained or/dor behaves correctly'); diff --git a/t/op/or.t b/t/op/or.t index 7a4997b..056989f 100644 --- a/t/op/or.t +++ b/t/op/or.t @@ -25,7 +25,7 @@ sub FETCH { package main; require './test.pl'; -plan( tests => 9 ); +plan( tests => 11 ); my ($a, $b, $c); @@ -72,3 +72,19 @@ for (pos $x || pos $y) { eval { $_++ }; } is(pos($y) || $@, 1, "|| propagates lvaluish context"); + +my $aa, $bb, $cc; +$bb = 1; + +my $res = 0; +# Well, really testing OP_DOR I guess +unless ($aa || $bb // $cc) { + $res = 1; +} +is($res, 0, "res is 0 after mixed OR/DOR"); + +$res = 0; +unless ($aa // $bb || $cc) { + $res = 1; +} +is($res, 0, "res is 0 after mixed DOR/OR"); -- Perl5 Master Repository