[TESTS] dumpvar.pl

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

p4raw-id: //depot/perl@21173

1 files changed, 45 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))) {