| Subject: | $Data::Dumper::Deparse does not handle blessed coderefs |
Dist: Data-Dumper-2.121, perl 5.6.1
OS: Debian GNU/Linux stable, i686, 2.2.25 kernel, gcc 2.95.4
Because B::Deparse::coderef2text expects an unblessed coderef, the following code barfs:
alex@ixion:~$ perl -MData::Dumper -e '$Data::Dumper::Deparse = 1; print Dumper( bless sub {}, 'My::Code' )'
Usage: ->coderef2text(CODEREF) at /s1/alex/local/lib/perl/5.6.1/Data/Dumper.pm line 383
Blessing the coderef to type 'CODE', then back to $type before and after the call to coderef2text fixes the problem. A patch is enclosed with this change and a test for blessed coderefs.
diff -ruN Data-Dumper-2.121/Changes Data-Dumper-2.122/Changes
--- Data-Dumper-2.121/Changes Fri Jan 16 19:02:42 2004
+++ Data-Dumper-2.122/Changes Fri Jan 16 19:12:20 2004
@@ -6,6 +6,11 @@
=over 8
+=item 2.122 (Jan 16 2004)
+
+Fix for blessed coderefs under $Data::Dumper::Deparse = 1
+by Alex Bowley <kilinrax@cpan.org>
+
=item 2.121 (Aug 24 2003)
Backport to 5.6.1 by Ilya Martynov <ilya@martynov.org>.
diff -ruN Data-Dumper-2.121/Dumper.pm Data-Dumper-2.122/Dumper.pm
--- Data-Dumper-2.121/Dumper.pm Fri Jan 16 19:02:42 2004
+++ Data-Dumper-2.122/Dumper.pm Fri Jan 16 19:16:59 2004
@@ -9,7 +9,7 @@
package Data::Dumper;
-$VERSION = '2.121';
+$VERSION = '2.122';
#$| = 1;
@@ -380,7 +380,9 @@
elsif ($realtype eq 'CODE') {
if ($s->{deparse}) {
require B::Deparse;
+ bless $val, 'CODE'; # handle blessed coderefs
my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val);
+ bless $val, $type;
$pad = $s->{sep} . $s->{pad} . $s->{xpad} . $s->{apad} . ' ';
$sub =~ s/\n/$pad/gse;
$out .= $sub;
diff -ruN Data-Dumper-2.121/t/dumper.t Data-Dumper-2.122/t/dumper.t
--- Data-Dumper-2.121/t/dumper.t Fri Jan 16 19:02:42 2004
+++ Data-Dumper-2.122/t/dumper.t Fri Jan 16 19:27:05 2004
@@ -79,11 +79,11 @@
$Data::Dumper::Useperl = 1;
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
- $TMAX = 363; $XS = 1;
+ $TMAX = 366; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 183; $XS = 0;
+ $TMAX = 186; $XS = 0;
}
print "1..$TMAX\n";
@@ -966,10 +966,20 @@
EOT
TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump);
-}
############# 214
##
+ $WANT = <<'EOT';
+#$VAR1 = bless( sub {
+# print 'foo';
+# }, 'My::Foo' );
+EOT
+
+ TEST q(Data::Dumper->new([ bless sub { print "foo"; }, 'My::Foo' ])->Dump);
+}
+
+############# 217
+##
# This is messy.
# The controls (bare numbers) are stored either as integers or floating point.
@@ -1193,7 +1203,7 @@
{
$a = "1\n";
-############# 310
+############# 313
## Perl code was using /...$/ and hence missing the \n.
$WANT = <<'EOT';
my $VAR1 = '42
@@ -1222,7 +1232,7 @@
-2147483648,
-2147483649,
);
-############# 316
+############# 319
## Perl code flips over at 10 digits.
$WANT = <<'EOT';
#$VAR1 = 999999999;
@@ -1282,7 +1292,7 @@
#XXX}
{
$b = "Bad. XS didn't escape dollar sign";
-############# 322
+############# 325
$WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
#\$VAR1 = '\$b\"\@\\\\\xA3';
EOT
@@ -1297,7 +1307,7 @@
TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
}
# XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
-############# 328
+############# 331
$WANT = <<'EOT';
#$VAR1 = '$b"';
EOT
@@ -1312,7 +1322,7 @@
# XS used to produce 'D'oh!' which is well, D'oh!
# Andreas found this one, which in turn discovered the previous two.
-############# 334
+############# 337
$WANT = <<'EOT';
#$VAR1 = 'D\'oh!';
EOT
@@ -1372,7 +1382,7 @@
TEST q(Data::Dumper->Dumpxs([\\%foo])),
"XS quotekeys == 0 for utf8 flagged ASCII" if $XS;
}
-############# 358
+############# 361
{
$WANT = <<'EOT';
#$VAR1 = [