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 { |
7 | if ($ENV{PERL_CORE}){ |
8 | chdir 't' if -d 't'; |
9 | unshift @INC, '../lib'; |
10 | require Config; import Config; |
11 | no warnings 'once'; |
12 | if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
13 | print "1..0 # Skip: Data::Dumper was not built\n"; |
14 | exit 0; |
15 | } |
16 | } |
17 | } |
18 | |
19 | use strict; |
20 | use Test::More qw(no_plan); |
21 | use Data::Dumper; |
22 | $Data::Dumper::Freezer = 'freeze'; |
23 | |
24 | # test for seg-fault bug when freeze() returns a non-ref |
25 | my $foo = Test1->new("foo"); |
26 | my $dumped_foo = Dumper($foo); |
27 | ok($dumped_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."); |
31 | |
32 | # run the same tests with useperl. this always worked |
33 | { |
34 | local $Data::Dumper::Useperl = 1; |
35 | my $foo = Test1->new("foo"); |
36 | my $dumped_foo = Dumper($foo); |
37 | ok($dumped_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."); |
41 | } |
42 | |
43 | # test for warning when an object doesn't have a freeze() |
44 | { |
45 | my $warned = 0; |
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."); |
50 | } |
51 | |
52 | |
53 | # run the same test with useperl, which always worked |
54 | { |
55 | local $Data::Dumper::Useperl = 1; |
56 | my $warned = 0; |
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"); |
61 | } |
62 | |
63 | # a freeze() which die()s should still trigger the warning |
64 | { |
65 | my $warned = 0; |
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."); |
70 | } |
71 | |
72 | # the same should work in useperl |
73 | { |
74 | local $Data::Dumper::Useperl = 1; |
75 | my $warned = 0; |
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."); |
80 | } |
81 | |
82 | # a package with a freeze() which returns a non-ref |
83 | package Test1; |
84 | sub new { bless({name => $_[1]}, $_[0]) } |
85 | sub freeze { |
86 | my $self = shift; |
87 | $self->{frozed} = 1; |
88 | } |
89 | |
90 | # a package without a freeze() |
91 | package Test2; |
92 | sub new { bless({name => $_[1]}, $_[0]) } |
93 | |
94 | # a package with a freeze() which dies |
95 | package Test3; |
96 | sub new { bless({name => $_[1]}, $_[0]) } |
97 | sub freeze { die "freeze() is broked" } |