Commit | Line | Data |
c5f7c514 |
1 | #!./perl -w |
2 | # |
3 | # test a few problems with the Freezer option, not a complete Freezer |
4 | # test suite yet |
5 | |
6 | BEGIN { |
f8e2702e |
7 | require Config; import Config; |
8 | no warnings 'once'; |
9 | if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
10 | print "1..0 # Skip: Data::Dumper was not built\n"; |
11 | exit 0; |
c5f7c514 |
12 | } |
13 | } |
14 | |
15 | use strict; |
16 | use Test::More qw(no_plan); |
17 | use Data::Dumper; |
18 | $Data::Dumper::Freezer = 'freeze'; |
19 | |
20 | # test for seg-fault bug when freeze() returns a non-ref |
21 | my $foo = Test1->new("foo"); |
22 | my $dumped_foo = Dumper($foo); |
23 | ok($dumped_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."); |
27 | |
28 | # run the same tests with useperl. this always worked |
29 | { |
30 | local $Data::Dumper::Useperl = 1; |
31 | my $foo = Test1->new("foo"); |
32 | my $dumped_foo = Dumper($foo); |
33 | ok($dumped_foo, |
34 | "Use of freezer sub which returns non-ref worked with useperl"); |
35 | like($dumped_foo, qr/frozed/, |
36 | "Dumped string has the key added by Freezer with useperl."); |
37 | } |
38 | |
39 | # test for warning when an object doesn't have a freeze() |
40 | { |
41 | my $warned = 0; |
42 | local $SIG{__WARN__} = sub { $warned++ }; |
43 | my $bar = Test2->new("bar"); |
44 | my $dumped_bar = Dumper($bar); |
45 | is($warned, 0, "A missing freeze() shouldn't warn."); |
46 | } |
47 | |
48 | |
49 | # run the same test with useperl, which always worked |
50 | { |
51 | local $Data::Dumper::Useperl = 1; |
52 | my $warned = 0; |
53 | local $SIG{__WARN__} = sub { $warned++ }; |
54 | my $bar = Test2->new("bar"); |
55 | my $dumped_bar = Dumper($bar); |
56 | is($warned, 0, "A missing freeze() shouldn't warn with useperl"); |
57 | } |
58 | |
59 | # a freeze() which die()s should still trigger the warning |
60 | { |
61 | my $warned = 0; |
62 | local $SIG{__WARN__} = sub { $warned++; }; |
63 | my $bar = Test3->new("bar"); |
64 | my $dumped_bar = Dumper($bar); |
65 | is($warned, 1, "A freeze() which die()s should warn."); |
66 | } |
67 | |
68 | # the same should work in useperl |
69 | { |
70 | local $Data::Dumper::Useperl = 1; |
71 | my $warned = 0; |
72 | local $SIG{__WARN__} = sub { $warned++; }; |
73 | my $bar = Test3->new("bar"); |
74 | my $dumped_bar = Dumper($bar); |
75 | is($warned, 1, "A freeze() which die()s should warn with useperl."); |
76 | } |
77 | |
78 | # a package with a freeze() which returns a non-ref |
79 | package Test1; |
80 | sub new { bless({name => $_[1]}, $_[0]) } |
81 | sub freeze { |
82 | my $self = shift; |
83 | $self->{frozed} = 1; |
84 | } |
85 | |
86 | # a package without a freeze() |
87 | package Test2; |
88 | sub new { bless({name => $_[1]}, $_[0]) } |
89 | |
90 | # a package with a freeze() which dies |
91 | package Test3; |
92 | sub new { bless({name => $_[1]}, $_[0]) } |
93 | sub freeze { die "freeze() is broked" } |