3 # test a few problems with the Freezer option, not a complete Freezer
7 require Config; import Config;
9 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
10 print "1..0 # Skip: Data::Dumper was not built\n";
16 use Test::More tests => 8;
18 use lib qw( ./t/lib );
19 use Testing qw( _dumptostr );
22 local $Data::Dumper::Freezer = 'freeze';
24 # test for seg-fault bug when freeze() returns a non-ref
26 my $foo = Test1->new("foo");
27 my $dumped_foo = Dumper($foo);
29 "Use of freezer sub which returns non-ref worked.");
30 like($dumped_foo, qr/frozed/,
31 "Dumped string has the key added by Freezer with useperl.");
32 like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
33 "Dumped list doesn't begin with Freezer's return value with useperl");
37 # test for warning when an object does not have a freeze()
40 local $SIG{__WARN__} = sub { $warned++ };
41 my $bar = Test2->new("bar");
42 my $dumped_bar = Dumper($bar);
43 is($warned, 0, "A missing freeze() shouldn't warn.");
47 # a freeze() which die()s should still trigger the warning
50 local $SIG{__WARN__} = sub { $warned++; };
51 my $bar = Test3->new("bar");
52 my $dumped_bar = Dumper($bar);
53 is($warned, 1, "A freeze() which die()s should warn.");
60 my $foo = Test1->new("foo");
62 local $Data::Dumper::Freezer = 'freeze';
63 $obj = Data::Dumper->new( [ $foo ] );
64 $dumps{'ddftrue'} = _dumptostr($obj);
65 local $Data::Dumper::Freezer = '';
67 $obj = Data::Dumper->new( [ $foo ] );
68 $obj->Freezer('freeze');
69 $dumps{'objset'} = _dumptostr($obj);
71 is($dumps{'ddftrue'}, $dumps{'objset'},
72 "\$Data::Dumper::Freezer and Freezer() are equivalent");
77 my $foo = Test1->new("foo");
79 local $Data::Dumper::Freezer = '';
80 $obj = Data::Dumper->new( [ $foo ] );
81 $dumps{'ddfemptystr'} = _dumptostr($obj);
83 local $Data::Dumper::Freezer = undef;
84 $obj = Data::Dumper->new( [ $foo ] );
85 $dumps{'ddfundef'} = _dumptostr($obj);
87 is($dumps{'ddfundef'}, $dumps{'ddfemptystr'},
88 "\$Data::Dumper::Freezer same with empty string or undef");
93 my $foo = Test1->new("foo");
95 $obj = Data::Dumper->new( [ $foo ] );
97 $dumps{'objemptystr'} = _dumptostr($obj);
99 $obj = Data::Dumper->new( [ $foo ] );
100 $obj->Freezer(undef);
101 $dumps{'objundef'} = _dumptostr($obj);
103 is($dumps{'objundef'}, $dumps{'objemptystr'},
104 "Freezer() same with empty string or undef");
108 # a package with a freeze() which returns a non-ref
110 sub new { bless({name => $_[1]}, $_[0]) }
116 # a package without a freeze()
118 sub new { bless({name => $_[1]}, $_[0]) }
120 # a package with a freeze() which dies
122 sub new { bless({name => $_[1]}, $_[0]) }
123 sub freeze { die "freeze() is broken" }