diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2017-10-23 09:50:10 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2017-10-23 09:52:02 -0700 |
| commit | f4a37198b80677735d8243e3538253bb7082c86e (patch) | |
| tree | 4627007fc218f1d70226470ee7bc2a682d16633b /ext/B | |
| parent | 6c2ae6421675ba5ff81dd43f9167136f02dfe9d9 (diff) | |
| download | perl-f4a37198b80677735d8243e3538253bb7082c86e.tar.gz | |
B::walksymtable: clear cached methods
There was a dummy assignment in B::walksymtable that I removed in com-
mit 6a4fc5265ba1 because it appeared to be redundant. Removing that
assignment broke Module::Info (rt.cpan.org #123352), because it
changed the behaviour of B::Utils (by changing the behaviour of
B::walksymtable). That seemingly useless assignment was actually
clearing cached methods, so that any B::GV object passed to the call-
back method sees ->CV pointing to something only if there is a real
sub there. Since this seems like a reasonable expectation, this com-
mit restores the old behaviour, with a comment explaining what the
assignment is for, and tests it.
Diffstat (limited to 'ext/B')
| -rw-r--r-- | ext/B/B.pm | 2 | ||||
| -rw-r--r-- | ext/B/t/b.t | 15 |
2 files changed, 17 insertions, 0 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index 3365a14f8c..77cbaf4bd7 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -261,6 +261,8 @@ sub walksymtable { no strict 'refs'; $prefix = '' unless defined $prefix; foreach my $sym ( sort keys %$symref ) { + my $dummy = $symref->{$sym}; # Copying the glob and incrementing + # the GPs refcnt clears cached methods $fullname = "*main::".$prefix.$sym; if ($sym =~ /::$/) { $sym = $prefix . $sym; diff --git a/ext/B/t/b.t b/ext/B/t/b.t index a5d724912b..587c8e665f 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -56,6 +56,21 @@ ok( join('', sort @syms) eq join('', sort keys %Subs), 'all symbols found' ); # Make sure we only hit them each once. ok( (!grep $_ != 1, values %Subs), '...and found once' ); + +# Make sure method caches are not present when walking the sym tab +@Testing::Method::Caches::Foo::ISA='Testing::Method::Caches::Bar'; +sub Testing::Method::Caches::Bar::foo{} +Testing::Method::Caches::Foo->foo; # caches the sub in the *foo glob + +my $have_cv; +sub B::GV::method_cache_test { ${shift->CV} and ++$have_cv } + +B::walksymtable(\%Testing::Method::Caches::, 'method_cache_test', + sub { 1 }, 'Testing::Method::Caches::'); +# $have_cv should only have been incremented for ::Bar::foo +is $have_cv, 1, 'walksymtable clears cached methods'; + + # Tests for MAGIC / MOREMAGIC ok( B::svref_2object(\$.)->MAGIC->TYPE eq "\0", '$. has \0 magic' ); { |