alternate way to figure out prototypes

Message-ID: <20020101224521.A691@rafael>

p4raw-id: //depot/perl@14007

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 778cec7..55b18a7 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -169,6 +169,9 @@ use warnings ();
 # keys are names of subs for which we've printed declarations.
 # That means we can omit parentheses from the arguments.
 #
+# subs_deparsed
+# Keeps track of fully qualified names of all deparsed subs.
+#
 # parens: -p
 # linenums: -l
 # unquote: -q
@@ -252,6 +255,9 @@ sub todo {
        $seq = 0;
     }
     push @{$self->{'subs_todo'}}, [$seq, $cv, $is_form];
+    unless ($is_form || class($cv->STASH) eq 'SPECIAL') {
+       $self->{'subs_deparsed'}{$cv->STASH->NAME."::".$cv->GV->NAME} = 1;
+    }
 }
 
 sub next_todo {
@@ -2961,10 +2967,21 @@ sub pp_entersub {
 
     # Doesn't matter how many prototypes there are, if
     # they haven't happened yet!
-    my $declared = exists $self->{'subs_declared'}{$kid};
-    if (!$declared && defined($proto)) {
-       # Avoid "too early to check prototype" warning
-       ($amper, $proto) = ('&');
+    my $declared;
+    {
+       no strict 'refs';
+       no warnings 'uninitialized';
+       $declared = exists $self->{'subs_declared'}{$kid}
+           || ( 
+                defined &{ %{$self->{'curstash'}."::"}->{$kid} }
+                && !exists
+                    $self->{'subs_deparsed'}{$self->{'curstash'}."::".$kid}
+                && defined prototype $self->{'curstash'}."::".$kid
+              );
+       if (!$declared && defined($proto)) {
+           # Avoid "too early to check prototype" warning
+           ($amper, $proto) = ('&');
+       }
     }
 
     my $args;