Re: unless(...) terser than if(!...)

Message-ID: <48B86060.4090905@profvince.com>

p4raw-id: //depot/perl@34310

diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t
index a8cb356..f28c688 100644 (file)
--- a/ext/B/t/deparse.t
+++ b/ext/B/t/deparse.t
@@ -27,7 +27,7 @@ BEGIN {
     require feature;
     feature->import(':5.10');
 }
-use Test::More tests => 64;
+use Test::More tests => 66;
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -432,3 +432,29 @@ use constant H => { "#" => 1 }; H->{"#"}
 # SKIP ?$B::Deparse::VERSION <= 0.87 && "TODO optimized away 0 not yet fixed"
 # 57  (cpan-bug #33708)
 foreach my $i (@_) { 0 }
+####
+# 58 tests with not, not optimized
+x() unless $a;
+x() if not $a and $b;
+x() if $a and not $b;
+x() unless not $a and $b;
+x() unless $a and not $b;
+x() if not $a or $b;
+x() if $a or not $b;
+x() unless not $a or $b;
+x() unless $a or not $b;
+####
+# 59 tests with not, optimized
+x() if not $a;
+x() unless not $a;
+x() if not $a and not $b;
+x() unless not $a and not $b;
+x() if not $a or not $b;
+x() unless not $a or not $b;
+>>>>
+x() unless $a;
+x() if $a;
+x() unless $a or $b;
+x() if $a or $b;
+x() unless $a and $b;
+x() unless not $a && $b;

diff --git a/lib/overload.t b/lib/overload.t
index 7c2476c..f10e092 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead
 package main;
 
 $| = 1;
-use Test::More tests => 558;
+use Test::More tests => 574;
 
 
 $a = new Oscalar "087";
@@ -1225,6 +1225,46 @@ foreach my $op (qw(<=> == != < <= > >=)) {
     ok(!$b, "Expect overloaded boolean");
     ok(!$a, "Expect overloaded boolean");
 }
+
+{
+    package Flrbbbbb;
+    use overload
+       bool     => sub { shift->{truth} eq 'yes' },
+       '0+'     => sub { shift->{truth} eq 'yes' ? '1' : '0' },
+       '!'      => sub { shift->{truth} eq 'no' },
+       fallback => 1;
+
+    sub new { my $class = shift; bless { truth => shift }, $class }
+
+    package main;
+
+    my $yes = Flrbbbbb->new('yes');
+    my $x;
+    $x = 1 if $yes;                    is($x, 1);
+    $x = 2 unless $yes;                        is($x, 1);
+    $x = 3 if !$yes;                   is($x, 1);
+    $x = 4 unless !$yes;               is($x, 4);
+
+    my $no = Flrbbbbb->new('no');
+    $x = 0;
+    $x = 1 if $no;                     is($x, 0);
+    $x = 2 unless $no;                 is($x, 2);
+    $x = 3 if !$no;                    is($x, 3);
+    $x = 4 unless !$no;                        is($x, 3);
+
+    $x = 0;
+    $x = 1 if !$no && $yes;            is($x, 1);
+    $x = 2 unless !$no && $yes;                is($x, 1);
+    $x = 3 if $no || !$yes;            is($x, 1);
+    $x = 4 unless $no || !$yes;                is($x, 4);
+
+    $x = 0;
+    $x = 1 if !$no || !$yes;           is($x, 1);
+    $x = 2 unless !$no || !$yes;       is($x, 1);
+    $x = 3 if !$no && !$yes;           is($x, 1);
+    $x = 4 unless !$no && !$yes;       is($x, 4);
+}
+
 {
     use Scalar::Util 'weaken';
 

diff --git a/op.c b/op.c
index 728be10..ef8fc1a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1138,6 +1138,20 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     case OP_OR:
     case OP_AND:
+       kid = cLOGOPo->op_first;
+       if (kid->op_type == OP_NOT
+           && (kid->op_flags & OPf_KIDS)
+           && !PL_madskills) {
+           if (o->op_type == OP_AND) {
+               o->op_type = OP_OR;
+               o->op_ppaddr = PL_ppaddr[OP_OR];
+           } else {
+               o->op_type = OP_AND;
+               o->op_ppaddr = PL_ppaddr[OP_AND];
+           }
+           op_null(kid);
+       }
+
     case OP_DOR:
     case OP_COND_EXPR:
     case OP_ENTERGIVEN:
@@ -4442,7 +4456,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     LOGOP *logop;
     OP *o;
     OP *first = *firstp;
-    OP * const other = *otherp;
+    OP *other = *otherp;
+    int prepend_not = 0;
 
     PERL_ARGS_ASSERT_NEW_LOGOP;
 
@@ -4450,10 +4465,11 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        return newBINOP(type, flags, scalar(first), scalar(other));
 
     scalarboolean(first);
-    /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
+    /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
-       && (first->op_flags & OPf_SPECIAL)
        && (first->op_flags & OPf_KIDS)
+       && ((first->op_flags & OPf_SPECIAL) /* unless ($x) { } */
+           || (other->op_type == OP_NOT))  /* if (!$x && !$y) { } */
        && !PL_madskills) {
        if (type == OP_AND || type == OP_OR) {
            if (type == OP_AND)
@@ -4466,6 +4482,15 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
                first->op_next = o->op_next;
            cUNOPo->op_first = NULL;
            op_free(o);
+           if (other->op_type == OP_NOT) { /* !a AND|OR !b => !(a OR|AND b) */
+               o = other;
+               other = *otherp = cUNOPo->op_first;
+               if (o->op_next)
+                   other->op_next = o->op_next;
+               cUNOPo->op_first = NULL;
+               op_free(o);
+               prepend_not = 1; /* prepend a NOT op later */
+           }
        }
     }
     if (first->op_type == OP_CONST) {
@@ -4582,7 +4607,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     CHECKOP(type,logop);
 
-    o = newUNOP(OP_NULL, 0, (OP*)logop);
+    o = newUNOP(prepend_not ? OP_NOT : OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
     return o;

diff --git a/t/op/do.t b/t/op/do.t
index 76d94c4..4fd7990 100755 (executable)
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -29,7 +29,7 @@ sub ok {
     return $ok;
 }
 
-print "1..22\n";
+print "1..26\n";
 
 # Test do &sub and proper @_ handling.
 $_[0] = 0;
@@ -92,6 +92,18 @@ ok( (!defined do 6) && $!, "'do 6' : $!" );
 push @t, ($u = (do {} . "This should be pushed."));
 ok( $#t == 0, "empty do result value" );
 
+$zok = '';
+$owww = do { 1 if $zok };
+ok( $owww eq '', 'last is unless' );
+$owww = do { 2 unless not $zok };
+ok( $owww == 1, 'last is if not' );
+
+$zok = 'swish';
+$owww = do { 3 unless $zok };
+ok( $owww eq 'swish', 'last is unless' );
+$owww = do { 4 if not $zok };
+ok( $owww eq '', 'last is if not' );
+
 END {
     1 while unlink("$$.16", "$$.17", "$$.18");
 }

diff --git a/t/op/lop.t b/t/op/lop.t
index d57271a..a78ac72 100755 (executable)
--- a/t/op/lop.t
+++ b/t/op/lop.t
@@ -9,7 +9,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..7\n";
+print "1..9\n";
 
 my $test = 0;
 for my $i (undef, 0 .. 2, "", "0 but true") {
@@ -42,3 +42,13 @@ my $i = 0;
 (($i ||= 1) &&= 3) += 4;
 print "not " unless $i == 7;
 print "ok ", ++$test, "\n";
+
+my ($x, $y) = (1, 8);
+$i = !$x || $y;
+print "not " unless $i == 8;
+print "ok ", ++$test, "\n";
+
+($x, $y) = (0, 9);
+$i = !$x && $y;
+print "not " unless $i == 9;
+print "ok ", ++$test, "\n";