dist/Data-Dumper/t/bugs.t

   1 #!perl
   2 #
   3 # regression tests for old bugs that do not fit other categories
   4
   5 BEGIN {
   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 use strict;
  15 use Test::More tests => 15;
  16 use Data::Dumper;
  17
  18 {
  19     sub iterate_hash {
  20         my ($h) = @_;
  21         my $count = 0;
  22         $count++ while each %$h;
  23         return $count;
  24     }
  25
  26     my $dumper = Data::Dumper->new( [\%ENV], ['ENV'] )->Sortkeys(1);
  27     my $orig_count = iterate_hash(\%ENV);
  28     $dumper->Dump;
  29     my $new_count = iterate_hash(\%ENV);
  30     is($new_count, $orig_count, 'correctly resets hash iterators');
  31 }
  32
  33 # [perl #38612] Data::Dumper core dump in 5.8.6, fixed by 5.8.7
  34 sub foo {
  35      my $s = shift;
  36      local $Data::Dumper::Terse = 1;
  37      my $c = eval Dumper($s);
  38      sub bar::quote { }
  39      bless $c, 'bar';
  40      my $d = Data::Dumper->new([$c]);
  41      $d->Freezer('quote');
  42      return $d->Dump;
  43 }
  44 foo({});
  45 ok(1, "[perl #38612]"); # Still no core dump? We are fine.
  46
  47 {
  48     my %h = (1,2,3,4);
  49     each %h;
  50
  51     my $d = Data::Dumper->new([\%h]);
  52     $d->Useqq(1);
  53     my $txt = $d->Dump();
  54     my $VAR1;
  55     eval $txt;
  56     is_deeply($VAR1, \%h, '[perl #40668] Reset hash iterator');
  57 }
  58
  59 # [perl #64744] Data::Dumper each() bad interaction
  60 {
  61     local $Data::Dumper::Useqq = 1;
  62     my $a = {foo => 1, bar => 1};
  63     each %$a;
  64     $a = {x => $a};
  65
  66     my $d = Data::Dumper->new([$a]);
  67     $d->Useqq(1);
  68     my $txt = $d->Dump();
  69     my $VAR1;
  70     eval $txt;
  71     is_deeply($VAR1, $a, '[perl #64744] Reset hash iterator');
  72 }
  73
  74 # [perl #56766] Segfaults on bad syntax - fixed with version 2.121_17
  75 sub doh
  76 {
  77     # 2nd arg is supposed to be an arrayref
  78     my $doh = Data::Dumper->Dump([\@_],'@_');
  79 }
  80 doh('fixed');
  81 ok(1, "[perl #56766]"); # Still no core dump? We are fine.
  82
  83 SKIP: {
  84  skip "perl 5.10.1 crashes and DD cannot help it", 1 if $] < 5.0119999;
  85  # [perl #72332] Segfault on empty-string glob
  86  Data::Dumper->Dump([*{*STDERR{IO}}]);
  87  ok("ok", #ok
  88    "empty-string glob [perl #72332]");
  89 }
  90
  91 # writing out of bounds with malformed utf8
  92 SKIP: {
  93     eval { require Encode };
  94     skip("Encode not available", 1) if $@;
  95     local $^W=1;
  96     local $SIG{__WARN__} = sub {};
  97     my $a="\x{fc}'" x 50;
  98     Encode::_utf8_on($a);
  99     Dumper $a;
 100     ok("ok", "no crash dumping malformed utf8 with the utf8 flag on");
 101 }
 102
 103 {
 104   # We have to test reference equivalence, rather than actual output, as
 105   # Perl itself is buggy prior to 5.15.6.  Output from DD should at least
 106   # evaluate to the same typeglob, regardless of perl bugs.
 107   my $tests = sub {
 108     my $VAR1;
 109     no strict 'refs';
 110     is eval(Dumper \*{"foo::b\0ar"}), \*{"foo::b\0ar"},
 111       'GVs with nulls';
 112     # There is a strange 5.6 bug that causes the eval to fail a supposed
 113     # strict vars test (involving $VAR1).  Mentioning the glob beforehand
 114     # somehow makes it go away.
 115     () = \*{chr 256};
 116     is eval Dumper(\*{chr 256})||die ($@), \*{chr 256},
 117       'GVs with UTF8 names (or not, depending on perl version)';
 118     () = \*{"\0".chr 256}; # same bug
 119     is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256},
 120       'GVs with UTF8 and nulls';
 121   };
 122   SKIP: {
 123     skip "no XS", 3 if not defined &Data::Dumper::Dumpxs;
 124     local $Data::Dumper::Useperl = 0;
 125     &$tests;
 126   }
 127   local $Data::Dumper::Useperl = 1;
 128   &$tests;
 129 }
 130
 131 {
 132   # Test reference equivalence of dumping *{""}.
 133   my $tests = sub {
 134     my $VAR1;
 135     no strict 'refs';
 136     is eval(Dumper \*{""}), \*{""}, 'dumping \*{""}';
 137   };
 138   SKIP: {
 139     skip "no XS", 1 if not defined &Data::Dumper::Dumpxs;
 140     local $Data::Dumper::Useperl = 0;
 141     &$tests;
 142   }
 143   local $Data::Dumper::Useperl = 1;
 144   &$tests;
 145 }
 146
 147 # EOF