diff options
| -rw-r--r-- | lib/dumpvar.pl | 54 | ||||
| -rw-r--r-- | lib/dumpvar.t | 94 |
2 files changed, 139 insertions, 9 deletions
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl index 12c9e91f0a..5c9100b65a 100644 --- a/lib/dumpvar.pl +++ b/lib/dumpvar.pl @@ -115,7 +115,7 @@ sub DumpElem { join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore"; } else { print "$short\n"; - unwrap($_[0],$_[1],$_[2]); + unwrap($_[0],$_[1],$_[2]) if ref $_[0]; } } @@ -136,7 +136,19 @@ sub unwrap { my $val = $v; $val = &{'overload::StrVal'}($v) if %overload:: and defined &{'overload::StrVal'}; - ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; + # Match type and address. + # Unblessed references will look like TYPE(0x...) + # Blessed references will look like Class=TYPE(0x...) + ($start_part, $val) = split /=/,$val; + $val = $start_part unless defined $val; + ($item_type, $address) = + $val =~ /([^\(]+) # Keep stuff that's + # not an open paren + \( # Skip open paren + (0x[0-9a-f]+) # Save the address + \) # Skip close paren + $/x; # Should be at end now + if (!$dumpReused && defined $address) { $address{$address}++ ; if ( $address{$address} > 1 ) { @@ -145,6 +157,7 @@ sub unwrap { } } } elsif (ref \$v eq 'GLOB') { + # This is a raw glob. Special handling for that. $address = "$v" . ""; # To avoid a bug with globs $address{$address}++ ; if ( $address{$address} > 1 ) { @@ -154,14 +167,16 @@ sub unwrap { } if (ref $v eq 'Regexp') { + # Reformat the regexp to look the standard way. my $re = "$v"; $re =~ s,/,\\/,g; print "$sp-> qr/$re/\n"; return; } - if ( UNIVERSAL::isa($v, 'HASH') ) { - @sortKeys = sort keys(%$v) ; + if ( $item_type eq 'HASH' ) { + # Hash ref or hash-based object. + my @sortKeys = sort keys(%$v) ; undef $more ; $tHashDepth = $#sortKeys ; $tHashDepth = $#sortKeys < $hashDepth-1 ? $#sortKeys : $hashDepth-1 @@ -193,14 +208,19 @@ sub unwrap { } print "$sp empty hash\n" unless @sortKeys; print "$sp$more" if defined $more ; - } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) { + } elsif ( $item_type eq 'ARRAY' ) { + # Array ref or array-based object. Also: undef. + # See how big the array is. $tArrayDepth = $#{$v} ; undef $more ; + # Bigger than the max? $tArrayDepth = $#{$v} < $arrayDepth-1 ? $#{$v} : $arrayDepth-1 if defined $arrayDepth && $arrayDepth ne ''; + # Yep. Don't show it all. $more = "....\n" if $tArrayDepth < $#{$v} ; $shortmore = ""; $shortmore = " ..." if $tArrayDepth < $#{$v} ; + if ($compactDump && !grep(ref $_, @{$v})) { if ($#$v >= 0) { $short = $sp . "0..$#{$v} " . @@ -220,20 +240,35 @@ sub unwrap { return if $DB::signal; print "$sp$num "; if (exists $v->[$num]) { - DumpElem $v->[$num], $s, $m-1; + if (defined $v->[$num]) { + DumpElem $v->[$num], $s, $m-1; + } + else { + print "undef\n"; + } } else { print "empty slot\n"; } } print "$sp empty array\n" unless @$v; print "$sp$more" if defined $more ; - } elsif ( UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) { + } elsif ( $item_type eq 'SCALAR' ) { + unless (defined $$v) { + print "$sp-> undef\n"; + return; + } print "$sp-> "; DumpElem $$v, $s, $m-1; - } elsif ( UNIVERSAL::isa($v, 'CODE') ) { + } elsif ( $item_type eq 'REF' ) { + print "$sp-> $$v\n"; + return unless defined $$v; + unwrap($$v, $s+3, $m-1); + } elsif ( $item_type eq 'CODE' ) { + # Code object or reference. print "$sp-> "; dumpsub (0, $v); - } elsif ( UNIVERSAL::isa($v, 'GLOB') ) { + } elsif ( $item_type eq 'GLOB' ) { + # Glob object or reference. print "$sp-> ",&stringify($$v,1),"\n"; if ($globPrint) { $s += 3; @@ -242,6 +277,7 @@ sub unwrap { print( (' ' x ($s+3)) . "FileHandle({$$v}) => fileno($fileno)\n" ); } } elsif (ref \$v eq 'GLOB') { + # Raw glob (again?) if ($globPrint) { dumpglob($s, "{$v}", $v, 1, $m-1) if $globPrint; } elsif (defined ($fileno = fileno(\$v))) { diff --git a/lib/dumpvar.t b/lib/dumpvar.t index dff7bb23dc..4101940886 100644 --- a/lib/dumpvar.t +++ b/lib/dumpvar.t @@ -25,6 +25,13 @@ require "dumpvar.pl"; sub unctrl { print dumpvar::unctrl($_[0]), "\n" } sub uniescape { print dumpvar::uniescape($_[0]), "\n" } sub stringify { print dumpvar::stringify($_[0]), "\n" } +sub dumpvalue { + local $\ = ''; + local $, = ''; + local $" = ' '; + my @params = @_; + &main::dumpValue(\@params, -1); +} package Foo; @@ -187,3 +194,90 @@ EXPECT 3 4 4 5 ######## +dumpvalue("a"); +EXPECT +0 'a' +######## +dumpvalue("\cA"); +EXPECT +0 "\cA" +######## +dumpvalue("\x{100}"); +EXPECT +0 '\x{0100}' +######## +dumpvalue(undef); +EXPECT +0 undef +######## +dumpvalue("foo"); +EXPECT +0 'foo' +######## +dumpvalue(\undef); +EXPECT +/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i +######## +dumpvalue(\\undef); +EXPECT +/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i +######## +dumpvalue([]); +EXPECT +/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i +######## +dumpvalue({}); +EXPECT +/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i +######## +dumpvalue(sub{}); +EXPECT +/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i +######## +dumpvalue(\*a); +EXPECT +/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i +######## +dumpvalue($foo); +EXPECT +/0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i +######## +dumpvalue($bar); +EXPECT +/0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i +######## +dumpvalue("1\n2\n3") +EXPECT +/0 '1\n2\n3'\n/i +######## +dumpvalue([1..4]); +EXPECT +/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i +######## +dumpvalue({1..4}); +EXPECT +/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i +######## +dumpvalue({1=>2,3=>4}); +EXPECT +/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i +######## +dumpvalue({a=>1,b=>2}); +EXPECT +/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i +######## +dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]); +EXPECT +/0 ARRAY\(0x[0-9a-f]+\)\n 0 HASH\(0x[0-9a-f]+\)\n 'a' => ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 'b' => HASH\(0x[0-9a-f]+\)\n 'c' => 1\n 'd' => 2\n 1 HASH\(0x[0-9a-f]+\)\n 'e' => HASH\(0x[0-9a-f]+\)\n 'f' => 1\n 'g' => 2\n 'h' => ARRAY\(0x[0-9a-f]+\)\n 0 'i'\n 1 'j'\n 2 'k'/i +######## +dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)}) +EXPECT +/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i +######## +my @x=qw(a b c); dumpvalue(\@x); +EXPECT +/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i +######## +my %x=(a=>1, b=>2); dumpvalue(\%x); +EXPECT +/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i |