Don't deparse recursively into recursive subroutines

[perl/modules/B-RecDeparse.git] / lib / B / RecDeparse.pm

diff --git a/lib/B/RecDeparse.pm b/lib/B/RecDeparse.pm
index 4f7b6361b923df0890348b39038f68f1167a5aa6..c5c5fa9be3fa40732248c2fe3b6a65bb220a1a48 100644 (file)
--- a/lib/B/RecDeparse.pm
+++ b/lib/B/RecDeparse.pm
@@ -5,6 +5,8 @@ use 5.008;
 use strict;
 use warnings;
 
+use B ();
+
 use Config;
 
 use base qw/B::Deparse/;
@@ -114,8 +116,9 @@ sub compile {
 sub init {
  my $self = shift;
 
- $self->{brd_cur} = 0;
- $self->{brd_sub} = 0;
+ $self->{brd_cur}  = 0;
+ $self->{brd_sub}  = 0;
+ $self->{brd_seen} = { };
 
  $self->SUPER::init(@_);
 }
@@ -137,6 +140,19 @@ if (FOOL_SINGLE_DELIM) {
  }
 }
 
+sub deparse_sub {
+ my $self = shift;
+ my $cv   = $_[0];
+
+ my $name;
+ unless ($cv->CvFLAGS & B::CVf_ANON()) {
+  $name = $cv->GV->SAFENAME;
+ }
+
+ local $self->{brd_seen}->{$name} = 1 if defined $name;
+ return $self->SUPER::deparse_sub(@_);
+}
+
 sub pp_entersub {
  my $self = shift;
 
@@ -162,14 +178,17 @@ sub pp_refgen {
 sub pp_gv {
  my $self = shift;
 
+ my $gv   = $self->gv_or_padgv($_[0]);
+ my $name = $gv->NAME;
+ my $seen = $self->{brd_seen};
+
  my $body;
- if ($self->{brd_sub} <= 0 || !$self->_recurse) {
+ if ($self->{brd_sub} <= 0 || !$self->_recurse || $seen->{$name}) {
   $body = $self->SUPER::pp_gv(@_);
  } else {
-  my $gv = $self->gv_or_padgv($_[0]);
-
   $body = do {
    local @{$self}{qw/brd_sub brd_cur/} = (0, $self->{brd_cur} + 1);
+   local $seen->{$name} = 1;
    'sub ' . $self->indent($self->deparse_sub($gv->CV));
   };
 
@@ -187,6 +206,8 @@ sub pp_gv {
 
 =head2 C<init>
 
+=head2 C<deparse_sub>
+
 =head2 C<pp_entersub>
 
 =head2 C<pp_refgen>