X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/17f410f9a3a4ae9cda502b59b391e6653db436ce..4c82ae22ce2b9a6d9891a286b3b4d41b58d56d4e:/lib/Dumpvalue.pm?ds=inline diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm index 33f6793..5d3a9da 100644 --- a/lib/Dumpvalue.pm +++ b/lib/Dumpvalue.pm @@ -347,16 +347,30 @@ sub dumpglob { } } +sub CvGV_name { + my $self = shift; + my $in = shift; + return if $self->{skipCvGV}; # Backdoor to avoid problems if XS broken... + $in = \&$in; # Hard reference... + eval {require Devel::Peek; 1} or return; + my $gv = Devel::Peek::CvGV($in) or return; + *$gv{PACKAGE} . '::' . *$gv{NAME}; +} + sub dumpsub { my $self = shift; my ($off,$sub) = @_; + my $ini = $sub; + my $s; $sub = $1 if $sub =~ /^\{\*(.*)\}$/; - my $subref = \&$sub; - my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub}) - || ($self->{subdump} && ($sub = $self->findsubs("$subref")) - && $DB::sub{$sub}); + my $subref = defined $1 ? \&$sub : \&$ini; + my $place = $DB::sub{$sub} || (($s = $subs{"$subref"}) && $DB::sub{$s}) + || (($s = $self->CvGV_name($subref)) && $DB::sub{$s}) + || ($self->{subdump} && ($s = $self->findsubs("$subref")) + && $DB::sub{$s}); + $s = $sub unless defined $s; $place = '???' unless defined $place; - print( (' ' x $off) . "&$sub in $place\n" ); + print( (' ' x $off) . "&$s in $place\n" ); } sub findsubs { @@ -390,7 +404,8 @@ sub dumpvars { next if @vars && !grep( matchvar($key, $_), @vars ); if ($self->{usageOnly}) { $self->globUsage(\$val, $key) - unless $package eq 'Dumpvalue' and $key eq 'stab'; + if ($package ne 'Dumpvalue' or $key ne 'stab') + and ref(\$val) eq 'GLOB'; } else { $self->dumpglob($package, 0,$key, $val); }