3 # test a few problems with the Freezer option, not a complete Freezer
9 unshift @INC, '../lib';
10 require Config; import Config;
12 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
13 print "1..0 # Skip: Data::Dumper was not built\n";
20 use Test::More qw(no_plan);
22 $Data::Dumper::Freezer = 'freeze';
24 # test for seg-fault bug when freeze() returns a non-ref
25 my $foo = Test1->new("foo");
26 my $dumped_foo = Dumper($foo);
28 "Use of freezer sub which returns non-ref worked.");
29 like($dumped_foo, qr/frozed/,
30 "Dumped string has the key added by Freezer.");
32 # run the same tests with useperl. this always worked
34 local $Data::Dumper::Useperl = 1;
35 my $foo = Test1->new("foo");
36 my $dumped_foo = Dumper($foo);
38 "Use of freezer sub which returns non-ref worked with useperl");
39 like($dumped_foo, qr/frozed/,
40 "Dumped string has the key added by Freezer with useperl.");
43 # test for warning when an object doesn't have a freeze()
46 local $SIG{__WARN__} = sub { $warned++ };
47 my $bar = Test2->new("bar");
48 my $dumped_bar = Dumper($bar);
49 is($warned, 0, "A missing freeze() shouldn't warn.");
53 # run the same test with useperl, which always worked
55 local $Data::Dumper::Useperl = 1;
57 local $SIG{__WARN__} = sub { $warned++ };
58 my $bar = Test2->new("bar");
59 my $dumped_bar = Dumper($bar);
60 is($warned, 0, "A missing freeze() shouldn't warn with useperl");
63 # a freeze() which die()s should still trigger the warning
66 local $SIG{__WARN__} = sub { $warned++; };
67 my $bar = Test3->new("bar");
68 my $dumped_bar = Dumper($bar);
69 is($warned, 1, "A freeze() which die()s should warn.");
72 # the same should work in useperl
74 local $Data::Dumper::Useperl = 1;
76 local $SIG{__WARN__} = sub { $warned++; };
77 my $bar = Test3->new("bar");
78 my $dumped_bar = Dumper($bar);
79 is($warned, 1, "A freeze() which die()s should warn with useperl.");
82 # a package with a freeze() which returns a non-ref
84 sub new { bless({name => $_[1]}, $_[0]) }
90 # a package without a freeze()
92 sub new { bless({name => $_[1]}, $_[0]) }
94 # a package with a freeze() which dies
96 sub new { bless({name => $_[1]}, $_[0]) }
97 sub freeze { die "freeze() is broked" }