diff options
| author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2002-01-01 23:45:21 +0100 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-01-01 23:48:19 +0000 |
| commit | 1d38190f803f2a83884e9591276436394df55dd4 (patch) | |
| tree | 653cab1e28e761d62c7a8e0b36007b8ca0065243 /ext/B | |
| parent | 73250e76b906d521a15f2d2c4ba0edef43d8a62b (diff) | |
| download | perl-1d38190f803f2a83884e9591276436394df55dd4.tar.gz | |
alternate way to figure out prototypes
Message-ID: <20020101224521.A691@rafael>
p4raw-id: //depot/perl@14007
Diffstat (limited to 'ext/B')
| -rw-r--r-- | ext/B/B/Deparse.pm | 25 |
1 files changed, 21 insertions, 4 deletions
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 778cec7bb8..55b18a7cad 100644 --- 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; |