dist/Data-Dumper/t/deparse.t

   1 #!./perl -w
   2 # t/deparse.t - Test Deparse()
   3
   4 BEGIN {
   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
  15 use strict;
  16
  17 use Data::Dumper;
  18 use Test::More tests =>  8;
  19 use lib qw( ./t/lib );
  20 use 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
  25 note("\$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