summaryrefslogtreecommitdiff
path: root/lib/dumpvar.pl
diff options
context:
space:
mode:
authorRicardo Signes <rjbs@cpan.org>2013-01-24 22:44:22 -0500
committerRicardo Signes <rjbs@cpan.org>2013-01-25 23:32:53 -0500
commit0d0268b0705058782fcff32c6184f87f39b5ae3b (patch)
tree2034fb8c2b4a9a791841e5498f81ae46ba63c03a /lib/dumpvar.pl
parent58cbf594161fa4470048f84f26076c4a69ba49d2 (diff)
downloadperl-0d0268b0705058782fcff32c6184f87f39b5ae3b.tar.gz
prevent failures deep in value dumping from aborting
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.
Diffstat (limited to 'lib/dumpvar.pl')
-rw-r--r--lib/dumpvar.pl18
1 files changed, 17 insertions, 1 deletions
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 7aadba1854..91153ea5ad 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -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 {