dist/Data-Dumper/t/bugs.t

   1 #!perl
   2 #
   3 # regression tests for old bugs that don't 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 => 7;
  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 # EOF