X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDumpvalue.pm;h=c8282cfbd5d4bec1759bda50fecbf286952e9626;hb=9c5c68c8d8cf29abcdb2ff421bcd6e5daedf49ec;hp=33f679363a800d07adec05ef580a72e51581b761;hpb=17f410f9a3a4ae9cda502b59b391e6653db436ce;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm index 33f6793..c8282cf 100644 --- a/lib/Dumpvalue.pm +++ b/lib/Dumpvalue.pm @@ -1,6 +1,7 @@ use 5.005_64; # for (defined ref) and $#$v and our package Dumpvalue; use strict; +our $VERSION = '1.00'; our(%address, $stab, @stab, %stab, %subs); # translate control chars to ^X - Randal Schwartz @@ -227,9 +228,9 @@ sub unwrap { if ($self->{compactDump} && !grep(ref $_, @{$v})) { if ($#$v >= 0) { $short = $sp . "0..$#{$v} " . - join(" ", - map {$self->stringify($_)} @{$v}[0..$tArrayDepth]) - . "$shortmore"; + join(" ", + map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} ($[..$tArrayDepth) + ) . "$shortmore"; } else { $short = $sp . "empty array"; } @@ -238,7 +239,11 @@ sub unwrap { for my $num ($[ .. $tArrayDepth) { return if $DB::signal and $self->{stopDbSignal}; print "$sp$num "; - $self->DumpElem($v->[$num], $s); + if (exists $v->[$num]) { + $self->DumpElem($v->[$num], $s); + } else { + print "empty slot\n"; + } } print "$sp empty array\n" unless @$v; print "$sp$more" if defined $more ; @@ -347,16 +352,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 +409,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); }