Data::Dumper: new test file (and new problem)

[Slaven Rezic]

While hunting for a Data::Dumper bug I created a new test file
(ext/Data/Dumper/t/freeze.t).

The bug seems only be triggered if Freeze/Thaw is used in the pure
perl version of Dump (Dumpxs works find) and the object type changes.
In the test script below, the Freeze method changes the object from a
hash to an array. This works OK in the XS version, while in the pure
perl version the object remains a hash after the Freeze method.

The failures are marked as TODO tests.

Regards,
Slaven

#!./perl -w
#
# test Freeze and Thaw
#

BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
print "1..0 # Skip: Data::Dumper was not built\n";
exit 0;
}
}

use strict;
use Data::Dumper;
use Config;

BEGIN {
if (!eval q{
use Test;
1;
}) {
print "1..0 # skip: tests only work with Test module\n";
exit;
}
}

BEGIN { plan tests => 1, todo => [7, 8] }

#
# example from pod
#
{
package Foo;
sub new { bless { state => 'awake' }, shift }
sub Freeze {
my $s = shift;
#print STDERR "preparing to sleep\n";
$s->{state} = 'asleep';
return bless $s, 'Foo::ZZZ';
}
}

{
package Foo::ZZZ;
sub Thaw {
my $s = shift;
#print STDERR "waking up\n";
$s->{state} = 'awake';
return bless $s, 'Foo';
}
}

for my $useperl (0, 1) {
local $Data::Dumper::Useperl = $useperl;

my $a = Foo->new;
my $b = Data::Dumper->new([$a], ['c']);
$b->Freezer('Freeze');
$b->Toaster('Thaw');
my $c = $b->Dump;
ok($c, <<'EOF', "freeze, \$Useperl is $useperl");
$c = bless( {
'state' => 'asleep'
}, 'Foo::ZZZ' )->Thaw();
EOF
my $d = eval $c;
ok(Data::Dumper->Dump([$d], ['d']), <<'EOF', "thaw, \$Useperl is $useperl");
$d = bless( {
'state' => 'awake'
}, 'Foo' );
EOF
}

#
# original is a hash-based object, while the serialization is an
# array-based object
#
{
package HashObj;
sub new { my $class = shift; bless { @_ }, $class }
sub Freeze {
my $s = shift;
bless [ %$s ], 'ArrayObj';
}
}

{
package ArrayObj;
sub Thaw {
my $s = shift;
bless { @$s }, 'HashObj';
}
}

for my $useperl (0, 1) {
local $Data::Dumper::Useperl = $useperl;

my $a = HashObj->new;
my $b = Data::Dumper->new([$a], ['c']);
$b->Freezer('Freeze');
$b->Toaster('Thaw');
my $c = $b->Dump;
ok($c, <<'EOF', "freeze, \$Useperl is $useperl");
$c = bless( [], 'ArrayObj' )->Thaw();
EOF
my $d = eval $c;
ok(Data::Dumper->Dump([$d], ['d']), <<'EOF', "thaw, \$Useperl is $useperl");
$d = bless( {}, 'HashObj' );
EOF
}

[h...@crypt.org]

Slaven Rezic <slaven...@berlin.de> wrote:
:While hunting for a Data::Dumper bug I created a new test file

:(ext/Data/Dumper/t/freeze.t).
:
:The bug seems only be triggered if Freeze/Thaw is used in the pure
:perl version of Dump (Dumpxs works find) and the object type changes.
:In the test script below, the Freeze method changes the object from a
:hash to an array. This works OK in the XS version, while in the pure
:perl version the object remains a hash after the Freeze method.

In your test:
: sub Freeze {

: my $s = shift;
: bless [ %$s ], 'ArrayObj';

: }
: sub Thaw {

: my $s = shift;
: bless { @$s }, 'HashObj';

: }
... you seem to rely on the freeze/toast methods returning the new
value, but in the docs it suggests that they must modify the objcet
in place.

Indeed, if I change the methods:
sub Freeze {
$_[0] = bless [ %{ $_[0] } ], 'ArrayObj';
}
sub Thaw {
$_[0] = bless { @{ $_[0] } }, 'HashObj';
}
... all tests pass.

The XS code is acting the way you expect rather than the way it is
documented. I'm not sure what the right way forward is from here -
I suspect we'll be breaking people's code whichever way we fix it -
but I think allowing the freeze/toast methods to return the modified
value is likely to be more useful. The simple patch below (not applied)
plus doc changes (not yet written) are enough to fix the perl version.

Hugo
--- ../perl/ext/Data/Dumper/Dumper.pm Fri Aug 23 00:59:24 2002
+++ ext/Data/Dumper/Dumper.pm Thu Oct 10 11:24:38 2002
@@ -231,7 +231,7 @@

# prep it, if it looks like an object
if (my $freezer = $s->{freezer}) {
- $val->$freezer() if UNIVERSAL::can($val, $freezer);
+ $val = $val->$freezer() if UNIVERSAL::can($val, $freezer);
}

($realpack, $realtype, $id) =