1#!./perl -w
2#
3# test a few problems with the Freezer option, not a complete Freezer
4# test suite yet
5
6use strict;
7use warnings;
8
9use Test::More tests =>  8;
10use Data::Dumper;
11use lib qw( ./t/lib );
12use Testing qw( _dumptostr );
13
14{
15    local $Data::Dumper::Freezer = 'freeze';
16
17    # test for seg-fault bug when freeze() returns a non-ref
18    {
19        my $foo = Test1->new("foo");
20        my $dumped_foo = Dumper($foo);
21        ok($dumped_foo,
22           "Use of freezer sub which returns non-ref worked.");
23        like($dumped_foo, qr/frozed/,
24             "Dumped string has the key added by Freezer with useperl.");
25        like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
26             "Dumped list doesn't begin with Freezer's return value with useperl");
27    }
28
29
30    # test for warning when an object does not have a freeze()
31    {
32        my $warned = 0;
33        local $SIG{__WARN__} = sub { $warned++ };
34        my $bar = Test2->new("bar");
35        my $dumped_bar = Dumper($bar);
36        is($warned, 0, "A missing freeze() shouldn't warn.");
37    }
38
39
40    # a freeze() which die()s should still trigger the warning
41    {
42        my $warned = 0;
43        local $SIG{__WARN__} = sub { $warned++; };
44        my $bar = Test3->new("bar");
45        my $dumped_bar = Dumper($bar);
46        is($warned, 1, "A freeze() which die()s should warn.");
47    }
48
49}
50
51{
52    my ($obj, %dumps);
53    my $foo = Test1->new("foo");
54
55    local $Data::Dumper::Freezer = 'freeze';
56    $obj = Data::Dumper->new( [ $foo ] );
57    $dumps{'ddftrue'} = _dumptostr($obj);
58    local $Data::Dumper::Freezer = '';
59
60    $obj = Data::Dumper->new( [ $foo ] );
61    $obj->Freezer('freeze');
62    $dumps{'objset'} = _dumptostr($obj);
63
64    is($dumps{'ddftrue'}, $dumps{'objset'},
65        "\$Data::Dumper::Freezer and Freezer() are equivalent");
66}
67
68{
69    my ($obj, %dumps);
70    my $foo = Test1->new("foo");
71
72    local $Data::Dumper::Freezer = '';
73    $obj = Data::Dumper->new( [ $foo ] );
74    $dumps{'ddfemptystr'} = _dumptostr($obj);
75
76    local $Data::Dumper::Freezer = undef;
77    $obj = Data::Dumper->new( [ $foo ] );
78    $dumps{'ddfundef'} = _dumptostr($obj);
79
80    is($dumps{'ddfundef'}, $dumps{'ddfemptystr'},
81        "\$Data::Dumper::Freezer same with empty string or undef");
82}
83
84{
85    my ($obj, %dumps);
86    my $foo = Test1->new("foo");
87
88    $obj = Data::Dumper->new( [ $foo ] );
89    $obj->Freezer('');
90    $dumps{'objemptystr'} = _dumptostr($obj);
91
92    $obj = Data::Dumper->new( [ $foo ] );
93    $obj->Freezer(undef);
94    $dumps{'objundef'} = _dumptostr($obj);
95
96    is($dumps{'objundef'}, $dumps{'objemptystr'},
97        "Freezer() same with empty string or undef");
98}
99
100
101# a package with a freeze() which returns a non-ref
102package Test1;
103sub new { bless({name => $_[1]}, $_[0]) }
104sub freeze {
105    my $self = shift;
106    $self->{frozed} = 1;
107}
108
109# a package without a freeze()
110package Test2;
111sub new { bless({name => $_[1]}, $_[0]) }
112
113# a package with a freeze() which dies
114package Test3;
115sub new { bless({name => $_[1]}, $_[0]) }
116sub freeze { die "freeze() is broken" }
117