op.c/peep.c - Optimise away empty else{} blocks

This is a replacement for #22745, which
aimed to prevent the associated `OP_STUB` from being created in
`Perl_newCONDOP` and subsequently removed in peep.c. However, doing that
turned out to be unavoidable, since it is not safe to omit the `OP_STUB`
if it is in scalar context, but `Perl_newCONDOP` runs before context is
applied.

This commit:
 * Re-adds the logic in `Perl_op_scope` to not wrap a bare `OP_STUB` in an
   `ENTER/LEAVE` pair.
 * Removes any relevant `OP_STUB`s in non-scalar context in `Perl_rpeep`.
 * Adds B::Deparse support
 * Adds a test based on the failures seen in #22866

Author: richardleach

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,13 +4034,22 @@ 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);
+
+    if (class($false) eq "NULL") { # Empty else {} block was optimised away
+        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);

lib/B/Deparse.t

@@ -3455,3 +3455,7 @@ $_ = (!$p) =~ s/1//r;
 my($x, $y, $z);
 $z = 1 + ($x ^^ $y);
 $z = ($x ^^= $y);
+####
+# Else block of a ternary is optimised away
+my $x;
+my(@y) = $x ? [1, 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);

peep.c

@@ -3588,6 +3588,21 @@ 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) {
+                /* Is there an empty "else" block or ternary false branch?
+                   If so, optimise away the OP_STUB if safe to do so. */
+                if (o->op_next->op_type == OP_STUB &&
+                    ((o->op_next->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
+                ) {
+                    OP *stub = o->op_next;
+                    assert(stub == OpSIBLING(OpSIBLING( cLOGOP->op_first )));
+                    assert(!(stub->op_flags & OPf_KIDS));
+                    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

@@ -1233,4 +1233,10 @@ test_opcount(0, "defined(ABC) gets constant folded",
                     defined      => 0,
                 });
 
+test_opcount(0, "Empty else{} blocks are optimised away",
+                sub { my $x; ($x) ? 1 : () },
+                {
+                    stub => 0
+                });
+
 done_testing();