This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Data::Dumper Freezer fixes
[perl5.git] / ext / Data / Dumper / t / freezer.t
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" }