diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 0bebe29f1fe2..8bf4145ea816 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -3966,13 +3966,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); diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index c39481bbe0e9..0865a356894d 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -3378,3 +3378,7 @@ $_ = (!$p) isa 'Some::Class'; $_ = (!$p) =~ tr/1//; $_ = (!$p) =~ /1/; $_ = (!$p) =~ s/1//r; +#### +# Else block of a ternary is optimised away +my $x; +my(@y) = $x ? [1, 2] : (); diff --git a/op.c b/op.c index 1b5c11c58bc1..943824158f0c 100644 --- a/op.c +++ b/op.c @@ -4517,6 +4517,12 @@ Perl_op_scope(pTHX_ OP *o) { if (o) { if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) { + + /* There's no need to wrap an empty stub in an enter/leave. + * 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); @@ -9268,7 +9274,6 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) logop = alloc_LOGOP(OP_COND_EXPR, first, LINKLIST(trueop)); logop->op_flags |= (U8)flags; logop->op_private = (U8)(1 | (flags >> 8)); - logop->op_next = LINKLIST(falseop); CHECKOP(OP_COND_EXPR, /* that's logop->op_type */ logop); @@ -9277,13 +9282,23 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) start = LINKLIST(first); first->op_next = (OP*)logop; - /* make first, trueop, falseop siblings */ + /* make first & trueop siblings */ + /* falseop may also be a sibling, if not optimised away */ op_sibling_splice((OP*)logop, first, 0, trueop); - op_sibling_splice((OP*)logop, trueop, 0, falseop); o = newUNOP(OP_NULL, 0, (OP*)logop); - trueop->op_next = falseop->op_next = o; + if (OP_TYPE_IS(falseop, OP_STUB) && (falseop->op_flags & OPf_PARENS)) { + /* The `else` block is empty. Optimise it away. */ + logop->op_next = o; + op_free(falseop); + } else { + op_sibling_splice((OP*)logop, trueop, 0, falseop); + logop->op_next = LINKLIST(falseop); + falseop->op_next = o; + } + + trueop->op_next = o; o->op_next = start; return o;