In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/de001ba03c571a64464f79c5cfa54a164b9bbce8?hp=b68eab22f47f27e55acb9cccd69e982cdd595f45>
- Log ----------------------------------------------------------------- commit de001ba03c571a64464f79c5cfa54a164b9bbce8 Author: Father Chrysostomos <[email protected]> Date: Fri Dec 5 14:46:53 2014 -0800 Deparse PVMG stubs Creating a weak reference to a stash entry will cause it to be of type PVMG, if it was not a GV already. B::Deparse was trying to determine, based on the internal SV type, whether it had a sub stub. It should be checking flags instead, otherwise valid stubs get omitted. M lib/B/Deparse.pm M lib/B/Deparse.t commit 67359f08ae288ccd943818bc458394bda2c8409f Author: Father Chrysostomos <[email protected]> Date: Fri Dec 5 06:21:35 2014 -0800 Deparse predeclared prototyped subs A predeclared sub without a prototype works fine: $ ./perl -Ilib -MO=Deparse -e 'sub f; sub f{}; foo()' sub f { } foo(); -e syntax OK A prototyped sub with no predeclaration is fine: $ ./perl -Ilib -MO=Deparse -e ' sub f($){}; foo()' sub f ($) { } foo(); -e syntax OK A prototyped stub is fine: $ ./perl -Ilib -MO=Deparse -e 'sub f($); foo()' sub f ($); foo(); -e syntax OK Only a predeclared prototyped sub seems to have trouble appear- ing properly: $ ./perl -Ilib -MO=Deparse -e 'sub f($); sub f($){}; foo()' sub f; foo(); -e syntax OK The code that searches the stashes (stash_subs) was assuming that any- thing of type B::PV was a prototype. In this case, the stash entry started as a string and then got âdowngradedâ to a reference, so internally it is of type PV (which can hold a ref), which B represents as B::PV, so the assumption that a PV is a prototyped stub is wrong. M lib/B/Deparse.pm M lib/B/Deparse.t ----------------------------------------------------------------------- Summary of changes: lib/B/Deparse.pm | 35 ++++++++++++++--------------------- lib/B/Deparse.t | 12 +++++++++++- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index dea21a9..a7dac05 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -698,8 +698,17 @@ sub stash_subs { }++; my %stash = svref_2object($stash)->ARRAY; while (my ($key, $val) = each %stash) { - my $class = class($val); - if ($class eq "PV") { + my $flags = $val->FLAGS; + if ($flags & SVf_ROK) { + # A reference. Dump this if it is a reference to a CV. + # But skip proxy constant subroutines, as some form of perl- + # space visible code must have created them, be it a use + # statement, or some direct symbol-table manipulation code that + # we will Deparse. + if (class(my $cv = $val->RV) eq "CV") { + $self->todo($cv, 0); + } + } elsif ($flags & (SVf_POK|SVf_IOK)) { # Just a prototype. As an ugly but fairly effective way # to find out if it belongs here is to see if the AUTOLOAD # (if any) for the stash was defined in one of our files. @@ -709,25 +718,9 @@ sub stash_subs { my $AF = $A->FILE; next unless $AF eq $0 || exists $self->{'files'}{$AF}; } - push @{$self->{'protos_todo'}}, [$pack . $key, $val->PV]; - } elsif ($class eq "IV" && !($val->FLAGS & SVf_ROK)) { - # Just a name. As above. - # But skip proxy constant subroutines, as some form of perl-space - # visible code must have created them, be it a use statement, or - # some direct symbol-table manipulation code that we will Deparse - my $A = $stash{"AUTOLOAD"}; - if (defined ($A) && class($A) eq "GV" && defined($A->CV) - && class($A->CV) eq "CV") { - my $AF = $A->FILE; - next unless $AF eq $0 || exists $self->{'files'}{$AF}; - } - push @{$self->{'protos_todo'}}, [$pack . $key, undef]; - } elsif ($class eq "IV") { - # A reference. Dump this if it is a reference to a CV. - if (class(my $cv = $val->RV) eq "CV") { - $self->todo($cv, 0); - } - } elsif ($class eq "GV") { + push @{$self->{'protos_todo'}}, + [$pack . $key, $flags & SVf_POK ? $val->PV: undef]; + } elsif (class($val) eq "GV") { if (class(my $cv = $val->CV) ne "SPECIAL") { next if $self->{'subs_done'}{$$val}++; next if $$val != ${$cv->GV}; # Ignore imposters diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index f39e1c8..1cf3b89 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -13,7 +13,7 @@ BEGIN { use warnings; use strict; -my $tests = 33; # not counting those in the __DATA__ section +my $tests = 35; # not counting those in the __DATA__ section use B::Deparse; my $deparse = B::Deparse->new(); @@ -343,6 +343,16 @@ like($a, qr/my sub __DATA__;\n.*\nCORE::__DATA__/s, # sub declarations $a = readpipe qq`$^X $path "-MO=Deparse" -e "sub foo{}" 2>&1`; like($a, qr/sub foo\s*\{\s+\}/, 'sub declarations'); +like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], + prog => 'sub f($); sub f($){}'), + qr/sub f\s*\(\$\)\s*\{\s*\}/, + 'predeclared prototyped subs'; +like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], + prog => 'use Scalar::Util q-weaken-; + sub f($); + BEGIN { weaken($_=\$::{f}) }'), + qr/sub f\s*\(\$\)\s*;/, + 'prototyped stub with weak reference to the stash entry'; # BEGIN blocks SKIP : { -- Perl5 Master Repository
