More paranoid _r protochecking. At least Tru64 and

[p5sagit/p5-mst-13.2.git] / lib / dumpvar.pl

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 4a3041a..184faa3 100644 (file)
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -30,7 +30,7 @@ sub main::dumpValue {
   local $^W=0;
   (print "undef\n"), return unless defined $_[0];
   (print &stringify($_[0]), "\n"), return unless ref $_[0];
-  dumpvar::unwrap($_[0],0);
+  dumpvar::unwrap($_[0],0, $_[1]);
 }
 
 # This one is good for variable names:
@@ -44,6 +44,12 @@ sub unctrl {
        $_;
 }
 
+sub uniescape {
+    join("",
+        map { $_ > 255 ? sprintf("\\x{%04X}", $_) : chr($_) }
+            unpack("U*", $_[0]));
+}
+
 sub stringify {
        local($_,$noticks) = @_;
        local($v) ; 
@@ -67,6 +73,7 @@ sub stringify {
        } elsif ($unctrl eq 'unctrl') {
          s/([\"\\])/\\$1/g ;
          s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+         # uniescape?
          s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg 
            if $quoteHighBit;
        } elsif ($unctrl eq 'quote') {
@@ -74,6 +81,7 @@ sub stringify {
          s/\033/\\e/g;
          s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
        }
+       $_ = uniescape($_);
        s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $quoteHighBit;
        ($noticks || /^\d+(\.\d*)?\Z/) 
          ? $_ 
@@ -107,7 +115,7 @@ sub DumpElem {
            join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore";
   } else {
     print "$short\n";
-    unwrap($_[0],$_[1]);
+    unwrap($_[0],$_[1],$_[2]);
   }
 }
 
@@ -115,6 +123,8 @@ sub unwrap {
     return if $DB::signal;
     local($v) = shift ; 
     local($s) = shift ; # extra no of spaces
+    local($m) = shift ; # maximum recursion depth
+    return if $m == 0;
     local(%v,@v,$sp,$value,$key,@sortKeys,$more,$shortmore,$short) ;
     local($tHashDepth,$tArrayDepth) ;
 
@@ -179,7 +189,7 @@ sub unwrap {
            return if $DB::signal;
            $value = $ {$v}{$key} ;
            print "$sp", &stringify($key), " => ";
-           DumpElem $value, $s;
+           DumpElem $value, $s, $m-1;
        }
        print "$sp  empty hash\n" unless @sortKeys;
        print "$sp$more" if defined $more ;
@@ -187,7 +197,7 @@ sub unwrap {
        $tArrayDepth = $#{$v} ; 
        undef $more ; 
        $tArrayDepth = $#{$v} < $arrayDepth-1 ? $#{$v} : $arrayDepth-1 
-         unless  $arrayDepth eq '' ; 
+         if defined $arrayDepth && $arrayDepth ne '';
        $more = "....\n" if $tArrayDepth < $#{$v} ; 
        $shortmore = "";
        $shortmore = " ..." if $tArrayDepth < $#{$v} ;
@@ -195,8 +205,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,13 +219,17 @@ sub unwrap {
        for $num ($[ .. $tArrayDepth) {
            return if $DB::signal;
            print "$sp$num  ";
-           DumpElem $v->[$num], $s;
+           if (exists $v->[$num]) {
+               DumpElem $v->[$num], $s, $m-1;
+           } 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' ) { 
            print "$sp-> ";
-           DumpElem $$v, $s;
+           DumpElem $$v, $s, $m-1;
     } elsif ( UNIVERSAL::isa($v, 'CODE') ) { 
            print "$sp-> ";
            dumpsub (0, $v);