3 # test a few problems with the Freezer option, not a complete Freezer
9 use Test::More tests => 7;
11 use lib qw( ./t/lib );
12 use Testing qw( _dumptostr );
14 local $Data::Dumper::Useperl = 1;
17 local $Data::Dumper::Freezer = 'freeze';
19 # test for seg-fault bug when freeze() returns a non-ref
21 my $foo = Test1->new("foo");
22 my $dumped_foo = Dumper($foo);
24 "Use of freezer sub which returns non-ref worked.");
25 like($dumped_foo, qr/frozed/,
26 "Dumped string has the key added by Freezer with useperl.");
27 like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
28 "Dumped list doesn't begin with Freezer's return value with useperl");
31 # test for warning when an object does not have a freeze()
34 local $SIG{__WARN__} = sub { $warned++ };
35 my $bar = Test2->new("bar");
36 my $dumped_bar = Dumper($bar);
37 is($warned, 0, "A missing freeze() shouldn't warn.");
40 # a freeze() which die()s should still trigger the warning
43 local $SIG{__WARN__} = sub { $warned++; };
44 my $bar = Test3->new("bar");
45 my $dumped_bar = Dumper($bar);
46 is($warned, 1, "A freeze() which die()s should warn.");
53 my $foo = Test1->new("foo");
55 local $Data::Dumper::Freezer = '';
56 $obj = Data::Dumper->new( [ $foo ] );
57 $dumps{'ddfemptystr'} = _dumptostr($obj);
59 local $Data::Dumper::Freezer = undef;
60 $obj = Data::Dumper->new( [ $foo ] );
61 $dumps{'ddfundef'} = _dumptostr($obj);
63 is($dumps{'ddfundef'}, $dumps{'ddfemptystr'},
64 "\$Data::Dumper::Freezer same with empty string or undef");
69 my $foo = Test1->new("foo");
71 $obj = Data::Dumper->new( [ $foo ] );
73 $dumps{'objemptystr'} = _dumptostr($obj);
75 $obj = Data::Dumper->new( [ $foo ] );
77 $dumps{'objundef'} = _dumptostr($obj);
79 is($dumps{'objundef'}, $dumps{'objemptystr'},
80 "Freezer() same with empty string or undef");
84 # a package with a freeze() which returns a non-ref
86 sub new { bless({name => $_[1]}, $_[0]) }
92 # a package without a freeze()
94 sub new { bless({name => $_[1]}, $_[0]) }
96 # a package with a freeze() which dies
98 sub new { bless({name => $_[1]}, $_[0]) }
99 sub freeze { die "freeze() is broken" }