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