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