prevent failures deep in value dumping from aborting
authorRicardo Signes <rjbs@cpan.org>
Fri, 25 Jan 2013 03:44:22 +0000 (22:44 -0500)
committerRicardo Signes <rjbs@cpan.org>
Sat, 26 Jan 2013 04:32:53 +0000 (23:32 -0500)
Sometimes, dumpvar's dumpvalue routine gets a value it can't dump.  The
simplest example to contrive is the one in this test: a tied hash that
can't tell you its keys.  Until now, this would cause the whole dump to
abort as soon as it failed to dump one part.

With this commit, each stringify or unwind is inside an eval.  Failed
stringifications or unwindings are replaced with a placeholder showing
the error.

unwind uses return to stop early, and rather than go through contortions
to wrap the eval in something that can then return 1 to test that eval
worked, I've just asserted that this code requires 5.14.0, which made $@
a much more reliable indicator of failure after eval.

lib/dumpvar.pl
lib/dumpvar.t

index 7aadba1..91153ea 100644 (file)
@@ -1,4 +1,4 @@
-require 5.002;                 # For (defined ref)
+require 5.014;                 # For more reliable $@ after eval
 package dumpvar;
 
 # Needed for PrettyPrinter only:
@@ -58,6 +58,15 @@ sub uniescape {
 }
 
 sub stringify {
+  my $string;
+  if (eval { $string = _stringify(@_); 1 }) {
+    return $string;
+  }
+
+  return "<< value could not be dumped: $@ >>";
+}
+
+sub _stringify {
     (my $__, local $noticks) = @_;
     for ($__) {
        local($v) ; 
@@ -160,6 +169,7 @@ sub unwrap {
     $sp = " " x $s ;
     $s += 3 ; 
 
+    eval {
     # Check for reused addresses
     if (ref $v) { 
       my $val = $v;
@@ -312,6 +322,12 @@ sub unwrap {
        print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
       }
     }
+    };
+    if ($@) {
+      print( (' ' x $s) .  "<< value could not be dumped: $@ >>\n");
+    }
+
+    return;
 }
 
 sub matchlex {
index f4f55d9..3e48b17 100644 (file)
@@ -54,6 +54,11 @@ package Tyre;
 sub TIESCALAR{bless[]}
 # other methods intentionally omitted
 
+package Kerb;
+
+sub TIEHASH{bless{}}
+# other methods intentionally omitted
+
 package main;
 
 my $foo = Foo->new(1..5);
@@ -331,3 +336,7 @@ EXPECT
 local *_; tie $_, 'Tyre'; unctrl('abc');
 EXPECT
 abc
+########
+tie my %h, 'Kerb'; my $v = { a => 1, b => \%h, c => 2 }; dumpvalue($v);
+EXPECT
+/'a' => 1\n.+Can't locate object method.+'c' => 2/s