Optimise away empty if{}, elsif{}. and else {} blocks

lib/B/Deparse.pm

@@ -7,7 +7,7 @@
 # This is based on the module of the same name by Malcolm Beattie,
 # but essentially none of his code remains.
 
-package B::Deparse 1.85;
+package B::Deparse 1.86;
 use strict;
 use Carp;
 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
@@ -4034,18 +4034,40 @@ sub pp_cond_expr {
     my $true = $cond->sibling;
     my $false = $true->sibling;
     my $cuddle = $self->{'cuddle'};
-    unless ($cx < 1 and (is_scope($true) and $true->name ne "null") and
-	    (is_scope($false) || is_ifelse_cont($false))
-	    and $self->{'expand'} < 7) {
-	$cond = $self->deparse($cond, 8);
-	$true = $self->deparse($true, 6);
-	$false = $self->deparse($false, 8);
-	return $self->maybe_parens("$cond ? $true : $false", $cx, 8);
+    my $no_true = 0;
+
+    if (class($false) eq "NULL") { # Empty true or false block was optimised away
+        if (!($op->flags & OPf_SPECIAL)) { # It was an empty true block
+            my $temp = $false; $false = $true; $true = $temp;
+            $no_true = 1;
+            unless ($cx < 1 and (is_scope($false) and $false->name ne "null")) {
+                $cond = $self->deparse($cond, 8);
+                $false = $self->deparse($false, 6);
+                return $self->maybe_parens("$cond ? () : $false", $cx, 8);
+            }
+        } else { # Must have been an empty false block
+            unless ($cx < 1 and (is_scope($true) and $true->name ne "null")) {
+                $cond = $self->deparse($cond, 8);
+                $true = $self->deparse($true, 6);
+                return $self->maybe_parens("$cond ? $true : ()", $cx, 8);
+            }
+        }
+    } else { # Both true and false branches are present
+        unless ($cx < 1 and (is_scope($true) and $true->name ne "null")
+               and (is_scope($false) || is_ifelse_cont($false))
+               and $self->{'expand'} < 7) {
+            $cond = $self->deparse($cond, 8);
+            $true = $self->deparse($true, 6);
+            $false = $self->deparse($false, 8);
+            return $self->maybe_parens("$cond ? $true : $false", $cx, 8);
+        }
     }
 
     $cond = $self->deparse($cond, 1);
-    $true = $self->deparse($true, 0);
-    my $head = $self->keyword("if") . " ($cond) {\n\t$true\n\b}";
+    $true = ($no_true) ? "\b" : $self->deparse($true, 0);
+    my $head = ($no_true)
+                ? $self->keyword("if") . " ($cond) {\n\t();\n\b}"
+                : $self->keyword("if") . " ($cond) {\n\t$true\n\b}";
     my @elsifs;
     my $elsif;
     while (!null($false) and is_ifelse_cont($false)) {
@@ -4060,13 +4082,24 @@ sub pp_cond_expr {
 	    $newcond = $newcond->first->sibling;
 	}
 	$newcond = $self->deparse($newcond, 1);
-	$newtrue = $self->deparse($newtrue, 0);
+
+        if (null($false) && ! ($newop->flags & OPf_SPECIAL)) {
+            # An empty elsif "true" block has been optimised away
+            my $temp = $false; $false = $newtrue; $newtrue = $temp;
+            $newtrue = "();";
+        } else {
+            $newtrue = $self->deparse($newtrue, 0);
+        }
+
 	$elsif ||= $self->keyword("elsif");
 	push @elsifs, "$elsif ($newcond) {\n\t$newtrue\n\b}";
     }
     if (!null($false)) {
 	$false = $cuddle . $self->keyword("else") . " {\n\t" .
 	  $self->deparse($false, 0) . "\n\b}\cK";
+    } elsif ($op->flags & OPf_SPECIAL) {
+        $false = $cuddle . $self->keyword("else") . " {\n\t" .
+          "();\n\b}\cK";
     } else {
 	$false = "\cK";
     }

lib/B/Deparse.t

@@ -3455,3 +3455,86 @@ $_ = (!$p) =~ s/1//r;
 my($x, $y, $z);
 $z = 1 + ($x ^^ $y);
 $z = ($x ^^= $y);
+####
+# Empty ? branch of a ternary is optimised away
+my $x;
+my(@y) = $x ? () : [1, 2];
+####
+# Empty : branch of a ternary is optimised away
+my $x;
+my(@y) = $x ? [1, 2] : ();
+####
+# Empty if {} block is optimised away
+my($x, $y);
+if ($x) {
+    ();
+}
+else {
+    $y = 1;
+}
+####
+# Empty else {} block is optimised away
+my($x, $y);
+if ($x) {
+    $y = 1;
+}
+else {
+    ();
+}
+####
+# Empty else {} preceded by an valid elsif
+my($x, $y);
+if ($x) {
+    $y = 1;
+}
+elsif ($y) {
+    $y = 2;
+}
+else {
+    ();
+}
+####
+# Empty elsif {} with valid else
+my($x, $y);
+if ($x) {
+    $y = 1;
+}
+elsif ($y) {
+    ();
+} else {
+    $y = 2;
+}
+####
+# Deparse of empty elsif sandwich (filling)
+my($x, $y);
+if ($x) {
+    $y = 1;
+}
+elsif ($y) {
+    $y = 3;
+}
+elsif ($y) {
+    ();
+}
+elsif ($y) {
+    $y = 4;
+} else {
+    $y = 2;
+}
+####
+# Deparse of empty elsif sandwich (bread)
+my($x, $y);
+if ($x) {
+    $y = 1;
+}
+elsif ($y) {
+    ();
+}
+elsif ($y) {
+    $y = 3;
+}
+elsif ($y) {
+    ();
+} else {
+    $y = 2;
+}

op.c

@@ -4524,6 +4524,11 @@ Perl_op_scope(pTHX_ OP *o)
 {
     if (o) {
         if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
+
+            /* This also makes eliding empty if/else blocks simpler. */
+            if (OP_TYPE_IS(o, OP_STUB) && (o->op_flags & OPf_PARENS))
+                return o;
+
             o = op_prepend_elem(OP_LINESEQ,
                     newOP(OP_ENTER, (o->op_flags & OPf_WANT)), o);
             OpTYPE_set(o, OP_LEAVE);

op.h

@@ -164,6 +164,8 @@ Deprecated.  Use C<GIMME_V> instead.
                                 /*  On OP_RETURN, module_true is in effect */
                                 /*  On OP_NEXT/OP_LAST/OP_REDO, there is no
                                  *  loop label */
+                                /*  On OP_COND_EXPR, indicates that an empty
+                                 *  "else" condition was optimized away. */
 /* There is no room in op_flags for this one, so it has its own bit-
    field member (op_folded) instead.  The flag is only used to tell
    op_convert_list to set op_folded.  */

peep.c

@@ -3588,6 +3588,45 @@ Perl_rpeep(pTHX_ OP *o)
                 S_check_for_bool_cxt(o, 1, OPpTRUEBOOL, 0);
             /* FALLTHROUGH */
         case OP_COND_EXPR:
+            if (o->op_type == OP_COND_EXPR) {
+                OP *stub = cLOGOP->op_other;
+                /* Is there an empty "if" block or ternary true branch?
+                   If so, optimise away the OP_STUB if safe to do so. */
+                if (stub->op_type == OP_STUB &&
+                    ((stub->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
+                ) {
+                    OP *trueop = OpSIBLING( cLOGOP->op_first );
+
+                    assert((stub == trueop ) || (OP_TYPE_IS(trueop, OP_SCOPE) &&
+                     ((stub == cUNOPx(trueop)->op_first)) && !OpSIBLING(stub))
+                    );
+                    assert(!(stub->op_flags & OPf_KIDS));
+
+                    cLOGOP->op_other = (stub->op_next == trueop) ?
+                                  stub->op_next->op_next  :
+                                  stub->op_next;
+
+                    op_sibling_splice(o, cLOGOP->op_first, 1, NULL);
+
+                    if (stub != trueop) op_free(stub);
+                    op_free(trueop);
+                } else
+
+                /* Is there an empty "else" block or ternary false branch?
+                   If so, optimise away the OP_STUB if safe to do so. */
+                stub = o->op_next;
+                if (stub->op_type == OP_STUB &&
+                    ((stub->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
+                ) {
+                    assert(stub == OpSIBLING(OpSIBLING( cLOGOP->op_first )));
+                    assert(!(stub->op_flags & OPf_KIDS));
+                    o->op_flags |= OPf_SPECIAL; /* For B::Deparse */
+                    o->op_next = stub->op_next;
+                    op_sibling_splice(o, OpSIBLING(cLOGOP->op_first), 1, NULL);
+                    op_free(stub);
+                }
+            }
+            /* FALLTHROUGH */
         case OP_MAPWHILE:
         case OP_ANDASSIGN:
         case OP_ORASSIGN:

t/op/cond.t

@@ -27,5 +27,15 @@ is( !$x ? 0 : 1, 1, 'run time, false');
     is $@, "", "SEGV in Perl_scalar";
 }
 
+# [GH #22866] The OP_STUB associated with an empty list should not
+# be optimised away if it's in scalar context (as it pushes PL_sv_undef
+# to the stack. In that event, these cases will trigger an assert under
+# DEBUGGING builds.
+
+{
+    my $x;
+    $x = ( $x ) ? "JAPH" : ();
+    $x = ( $x ) ? () : "JAPH";
+}
 
 done_testing();

t/perf/opcount.t

@@ -1106,4 +1106,16 @@ test_opcount(0, "substr with const zero offset  (gv)",
                     sassign      => 1
                 });
 
+test_opcount(0, "Empty if{} blocks are optimised away",
+                sub { my $x; ($x) ? () : 1 },
+                {
+                    stub => 0
+                });
+
+test_opcount(0, "Empty else{} blocks are optimised away",
+                sub { my $x; ($x) ? 1 : () },
+                {
+                    stub => 0
+                });
+
 done_testing();