1#!./perl -w 2# t/deparse.t - Test Deparse() 3 4use strict; 5use warnings; 6 7use Data::Dumper; 8use Test::More tests => 16; 9use lib qw( ./t/lib ); 10use Testing qw( _dumptostr ); 11 12# Thanks to Arthur Axel "fREW" Schmidt: 13# http://search.cpan.org/~frew/Data-Dumper-Concise-2.020/lib/Data/Dumper/Concise.pm 14 15note("\$Data::Dumper::Deparse and Deparse()"); 16 17for my $useperl (0, 1) { 18 local $Data::Dumper::Useperl = $useperl; 19 20 my ($obj, %dumps, $deparse, $starting); 21 use strict; 22 my $struct = { foo => "bar\nbaz", quux => sub { "fleem" } }; 23 $obj = Data::Dumper->new( [ $struct ] ); 24 $dumps{'noprev'} = _dumptostr($obj); 25 26 $starting = $Data::Dumper::Deparse; 27 local $Data::Dumper::Deparse = 0; 28 $obj = Data::Dumper->new( [ $struct ] ); 29 $dumps{'dddzero'} = _dumptostr($obj); 30 local $Data::Dumper::Deparse = $starting; 31 32 $obj = Data::Dumper->new( [ $struct ] ); 33 $obj->Deparse(); 34 $dumps{'objempty'} = _dumptostr($obj); 35 36 $obj = Data::Dumper->new( [ $struct ] ); 37 $obj->Deparse(0); 38 $dumps{'objzero'} = _dumptostr($obj); 39 40 is($dumps{'noprev'}, $dumps{'dddzero'}, 41 "No previous setting and \$Data::Dumper::Deparse = 0 are equivalent (useperl=$useperl)"); 42 is($dumps{'noprev'}, $dumps{'objempty'}, 43 "No previous setting and Deparse() are equivalent (useperl=$useperl)"); 44 is($dumps{'noprev'}, $dumps{'objzero'}, 45 "No previous setting and Deparse(0) are equivalent (useperl=$useperl)"); 46 47 local $Data::Dumper::Deparse = 1; 48 $obj = Data::Dumper->new( [ $struct ] ); 49 $dumps{'dddtrue'} = _dumptostr($obj); 50 local $Data::Dumper::Deparse = $starting; 51 52 $obj = Data::Dumper->new( [ $struct ] ); 53 $obj->Deparse(1); 54 $dumps{'objone'} = _dumptostr($obj); 55 56 is($dumps{'dddtrue'}, $dumps{'objone'}, 57 "\$Data::Dumper::Deparse = 1 and Deparse(1) are equivalent (useperl=$useperl)"); 58 59 isnt($dumps{'dddzero'}, $dumps{'dddtrue'}, 60 "\$Data::Dumper::Deparse = 0 differs from \$Data::Dumper::Deparse = 1 (useperl=$useperl)"); 61 62 like($dumps{'dddzero'}, 63 qr/quux.*?sub.*?DUMMY/s, 64 "\$Data::Dumper::Deparse = 0 reports DUMMY instead of deparsing coderef (useperl=$useperl)"); 65 unlike($dumps{'dddtrue'}, 66 qr/quux.*?sub.*?DUMMY/s, 67 "\$Data::Dumper::Deparse = 1 does not report DUMMY (useperl=$useperl)"); 68 like($dumps{'dddtrue'}, 69 qr/quux.*?sub.*?use\sstrict.*?fleem/s, 70 "\$Data::Dumper::Deparse = 1 deparses coderef (useperl=$useperl)"); 71} 72 73