This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make B::Concise handle subrefs in stashes
authorFather Chrysostomos <sprout@cpan.org>
Mon, 11 Sep 2017 04:46:41 +0000 (21:46 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 8 Oct 2017 20:02:03 +0000 (13:02 -0700)
The concise_stashref sub, for dumping all subroutines in a package,
would assign the value of a stash element to *s, and then use *s
to access the code ref in it.  If you do *s = *foo and then later
*s = \&bar, then you have assigned \&bar to *foo{CODE}, and even
a localisation of *s beforehand will not help.  That is exactly
what B::Concise was doing when dumping a package with some subref
elements.

ext/B/B/Concise.pm

index 6465a3c..a53e28f 100644 (file)
@@ -145,13 +145,14 @@ sub concise_subref {
 
 sub concise_stashref {
     my($order, $h) = @_;
 
 sub concise_stashref {
     my($order, $h) = @_;
-    local *s;
+    my $name = svref_2object($h)->NAME;
     foreach my $k (sort keys %$h) {
        next unless defined $h->{$k};
     foreach my $k (sort keys %$h) {
        next unless defined $h->{$k};
-       *s = $h->{$k};
-       my $coderef = *s{CODE} or next;
+       my $coderef = ref $h->{$k} eq 'CODE' ? $h->{$k}
+                   : ref\$h->{$k} eq 'GLOB' ? *{$h->{$k}}{CODE} || next
+                   : next;
        reset_sequence();
        reset_sequence();
-       print "FUNC: ", *s, "\n";
+       print "FUNC: *", $name, "::", $k, "\n";
        my $codeobj = svref_2object($coderef);
        next unless ref $codeobj eq 'B::CV';
        eval { concise_cv_obj($order, $codeobj, $k) };
        my $codeobj = svref_2object($coderef);
        next unless ref $codeobj eq 'B::CV';
        eval { concise_cv_obj($order, $codeobj, $k) };