X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fdumpvar.pl;h=51e9c88ea3da555fe702d9b0412ac54a74e9c636;hb=78b3f29973d20003799b839f78876dbf59ab60fe;hp=f473c45bd3fbd12d6e406db93d0b40227a2043c5;hpb=2c2d71f566f0a758d1486480f45158c0e70ea496;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl index f473c45..51e9c88 100644 --- a/lib/dumpvar.pl +++ b/lib/dumpvar.pl @@ -195,8 +195,8 @@ sub unwrap { if ($#$v >= 0) { $short = $sp . "0..$#{$v} " . join(" ", - map {stringify $_} @{$v}[0..$tArrayDepth]) - . "$shortmore"; + map {exists $v->[$_] ? stringify $v->[$_] : "empty"} ($[..$tArrayDepth) + ) . "$shortmore"; } else { $short = $sp . "empty array"; } @@ -209,7 +209,11 @@ sub unwrap { for $num ($[ .. $tArrayDepth) { return if $DB::signal; print "$sp$num "; - DumpElem $v->[$num], $s; + if (exists $v->[$num]) { + DumpElem $v->[$num], $s; + } else { + print "empty slot\n"; + } } print "$sp empty array\n" unless @$v; print "$sp$more" if defined $more ; @@ -312,14 +316,27 @@ sub dumpglob { } } +sub CvGV_name_or_bust { + my $in = shift; + return if $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 ($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}) - || ($subdump && ($sub = findsubs("$subref")) && $DB::sub{$sub}); + my $subref = defined $1 ? \&$sub : \&$ini; + my $place = $DB::sub{$sub} || (($s = $subs{"$subref"}) && $DB::sub{$s}) + || (($s = CvGV_name_or_bust($subref)) && $DB::sub{$s}) + || ($subdump && ($s = findsubs("$subref")) && $DB::sub{$s}); $place = '???' unless defined $place; - print( (' ' x $off) . "&$sub in $place\n" ); + $s = $sub unless defined $s; + print( (' ' x $off) . "&$s in $place\n" ); } sub findsubs { @@ -348,7 +365,9 @@ sub main::dumpvar { return if $DB::signal; next if @vars && !grep( matchvar($key, $_), @vars ); if ($usageOnly) { - globUsage(\$val, $key) unless $package eq 'dumpvar' and $key eq 'stab'; + globUsage(\$val, $key) + if ($package ne 'dumpvar' or $key ne 'stab') + and ref(\$val) eq 'GLOB'; } else { dumpglob(0,$key, $val); }