Change 14007: [PATCH B::Deparse] alternate way to figure out prototypes

[Jarkko Hietaniemi]

Change 14007 by jhi@alpha on 2002/01/01 23:48:19

        Subject: [PATCH B::Deparse] alternate way to figure out prototypes
        From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
        Date: Tue, 1 Jan 2002 22:45:21 +0100       
        Message-ID: <20020101224521.A691@rafael>

Affected files ...

.... //depot/perl/ext/B/B/Deparse.pm#100 edit

Differences ...

==== //depot/perl/ext/B/B/Deparse.pm#100 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm.~1~ Tue Jan  1 17:00:05 2002
+++ perl/ext/B/B/Deparse.pm     Tue Jan  1 17:00:05 2002
@@ -169,6 +169,9 @@
 # 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 @@
        $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 @@
 
     # 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;
End of Patch.