[TESTS] dumpvar.pl

Message-ID: <Pine.LNX.4.44.0309102337150.2043-300000@tribal.metalab.unc.edu>

p4raw-id: //depot/perl@21173

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 12c9e91..5c9100b 100644 (file)
--- 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 dff7bb2..4101940 100644 (file)
--- 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