In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/1cc318ccd01de3f743427faa3a82731c57c38a1c?hp=6c2ae6421675ba5ff81dd43f9167136f02dfe9d9>
- Log -----------------------------------------------------------------
commit 1cc318ccd01de3f743427faa3a82731c57c38a1c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Oct 23 09:52:23 2017 -0700
Increase $B::VERSION to 1.71
commit f4a37198b80677735d8243e3538253bb7082c86e
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Oct 23 09:50:10 2017 -0700
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.
-----------------------------------------------------------------------
Summary of changes:
ext/B/B.pm | 4 +++-
ext/B/t/b.t | 15 +++++++++++++++
2 files changed, 18 insertions(+), 1 deletion(-)
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 3365a14f8c..12d8201619 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -15,7 +15,7 @@ require Exporter;
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.70';
+ $B::VERSION = '1.71';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -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' );
{
--
Perl5 Master Repository
