[PATCH B::Deparse] non-block scopes

The patch below causes B::Deparse to honour non-block scopes, so
that tests like:

  my $x="ok 1\n";
  do {
    my $x="not ok 1\n";
  };
  print $x;

will pass after being passed through it. (Another variation is
C<if (1) { ... }>).

I realise that the implementation might get me lynched. In my defense
I can say:

 * this patch is short

 * I can't think of a better way to do it which doesn't involve
   rewriting the whole module.

If you _can_ think of a better way, please let me know!

 .robin.


--- ext/B/B/Deparse.pm.sent6	Fri Apr 27 17:20:26 2001
+++ ext/B/B/Deparse.pm	Fri Apr 27 19:02:27 2001
@@ -1024,7 +1024,22 @@
     }
 }
 
-sub pp_scope { scopeop(0, @_); }
+sub invoker {
+    my $caller = (caller(2))[3];
+    if ($caller eq "B::Deparse::deparse") {
+	return (caller(3))[3];
+    }
+    else {
+	return $caller;
+    }
+}
+
+sub pp_scope {
+    my ($self, $op, $cx) = @_;
+    my $body = scopeop(0, @_);
+    return $body if $cx > 0 || invoker() ne "B::Deparse::lineseq";
+    return "do {\n\t$body\n\b};";
+}
 sub pp_lineseq { scopeop(0, @_); }
 sub pp_leave { scopeop(1, @_); }
 
@@ -2347,6 +2362,8 @@
 	return $self->maybe_parens($self->deparse($op->first, 20) . " =~ "
 				   . $self->deparse($op->first->sibling, 20),
 				   $cx, 20);
+    } elsif ($op->flags & OPf_SPECIAL && $cx == 0 && !$op->targ) {
+	return "do {\n\t". $self->deparse($op->first, $cx) ."\n\b};";
     } else {
 	return $self->deparse($op->first, $cx);
     }

• [PATCH B::Deparse] non-block scopes by Robin Houston
• Re: [PATCH B::Deparse] non-block scopes by Jarkko Hietaniemi