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 => 7; 10use Data::Dumper; 11use lib qw( ./t/lib ); 12use Testing qw( _dumptostr ); 13 14local $Data::Dumper::Useperl = 1; 15 16{ 17 local $Data::Dumper::Freezer = 'freeze'; 18 19 # test for seg-fault bug when freeze() returns a non-ref 20 { 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 with useperl."); 27 like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /, 28 "Dumped list doesn't begin with Freezer's return value with useperl"); 29 } 30 31 # test for warning when an object does not have a freeze() 32 { 33 my $warned = 0; 34 local $SIG{__WARN__} = sub { $warned++ }; 35 my $bar = Test2->new("bar"); 36 my $dumped_bar = Dumper($bar); 37 is($warned, 0, "A missing freeze() shouldn't warn."); 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 = ''; 56 $obj = Data::Dumper->new( [ $foo ] ); 57 $dumps{'ddfemptystr'} = _dumptostr($obj); 58 59 local $Data::Dumper::Freezer = undef; 60 $obj = Data::Dumper->new( [ $foo ] ); 61 $dumps{'ddfundef'} = _dumptostr($obj); 62 63 is($dumps{'ddfundef'}, $dumps{'ddfemptystr'}, 64 "\$Data::Dumper::Freezer same with empty string or undef"); 65} 66 67{ 68 my ($obj, %dumps); 69 my $foo = Test1->new("foo"); 70 71 $obj = Data::Dumper->new( [ $foo ] ); 72 $obj->Freezer(''); 73 $dumps{'objemptystr'} = _dumptostr($obj); 74 75 $obj = Data::Dumper->new( [ $foo ] ); 76 $obj->Freezer(undef); 77 $dumps{'objundef'} = _dumptostr($obj); 78 79 is($dumps{'objundef'}, $dumps{'objemptystr'}, 80 "Freezer() same with empty string or undef"); 81} 82 83 84# a package with a freeze() which returns a non-ref 85package Test1; 86sub new { bless({name => $_[1]}, $_[0]) } 87sub freeze { 88 my $self = shift; 89 $self->{frozed} = 1; 90} 91 92# a package without a freeze() 93package Test2; 94sub new { bless({name => $_[1]}, $_[0]) } 95 96# a package with a freeze() which dies 97package Test3; 98sub new { bless({name => $_[1]}, $_[0]) } 99sub freeze { die "freeze() is broken" } 100