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 => 7;
18 use lib qw( ./t/lib );
19 use Testing qw( _dumptostr );
21 local $Data::Dumper::Useperl = 1;
24 local $Data::Dumper::Freezer = 'freeze';
26 # test for seg-fault bug when freeze() returns a non-ref
28 my $foo = Test1->new("foo");
29 my $dumped_foo = Dumper($foo);
31 "Use of freezer sub which returns non-ref worked.");
32 like($dumped_foo, qr/frozed/,
33 "Dumped string has the key added by Freezer with useperl.");
34 like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
35 "Dumped list doesn't begin with Freezer's return value with useperl");
38 # test for warning when an object does not have a freeze()
41 local $SIG{__WARN__} = sub { $warned++ };
42 my $bar = Test2->new("bar");
43 my $dumped_bar = Dumper($bar);
44 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 = '';
63 $obj = Data::Dumper->new( [ $foo ] );
64 $dumps{'ddfemptystr'} = _dumptostr($obj);
66 local $Data::Dumper::Freezer = undef;
67 $obj = Data::Dumper->new( [ $foo ] );
68 $dumps{'ddfundef'} = _dumptostr($obj);
70 is($dumps{'ddfundef'}, $dumps{'ddfemptystr'},
71 "\$Data::Dumper::Freezer same with empty string or undef");
76 my $foo = Test1->new("foo");
78 $obj = Data::Dumper->new( [ $foo ] );
80 $dumps{'objemptystr'} = _dumptostr($obj);
82 $obj = Data::Dumper->new( [ $foo ] );
84 $dumps{'objundef'} = _dumptostr($obj);
86 is($dumps{'objundef'}, $dumps{'objemptystr'},
87 "Freezer() same with empty string or undef");
91 # a package with a freeze() which returns a non-ref
93 sub new { bless({name => $_[1]}, $_[0]) }
99 # a package without a freeze()
101 sub new { bless({name => $_[1]}, $_[0]) }
103 # a package with a freeze() which dies
105 sub new { bless({name => $_[1]}, $_[0]) }
106 sub freeze { die "freeze() is broken" }