ext/Data-Dumper/t/bugs.t

   1 #!perl
   2 #
   3 # regression tests for old bugs that don't fit other categories
   4
   5 BEGIN {
   6     if ($ENV{PERL_CORE}){
   7         chdir 't' if -d 't';
   8         unshift @INC, '../lib';
   9         require Config; import Config;
  10         no warnings 'once';
  11         if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
  12             print "1..0 # Skip: Data::Dumper was not built\n";
  13             exit 0;
  14         }
  15     }
  16 }
  17
  18 use strict;
  19 use Test::More tests => 5;
  20 use Data::Dumper;
  21
  22 {
  23     sub iterate_hash {
  24         my ($h) = @_;
  25         my $count = 0;
  26         $count++ while each %$h;
  27         return $count;
  28     }
  29
  30     my $dumper = Data::Dumper->new( [\%ENV], ['ENV'] )->Sortkeys(1);
  31     my $orig_count = iterate_hash(\%ENV);
  32     $dumper->Dump;
  33     my $new_count = iterate_hash(\%ENV);
  34     is($new_count, $orig_count, 'correctly resets hash iterators');
  35 }
  36
  37 # [perl #38612] Data::Dumper core dump in 5.8.6, fixed by 5.8.7
  38 sub foo {
  39      my $s = shift;
  40      local $Data::Dumper::Terse = 1;
  41      my $c = eval Dumper($s);
  42      sub bar::quote { }
  43      bless $c, 'bar';
  44      my $d = Data::Dumper->new([$c]);
  45      $d->Freezer('quote');
  46      return $d->Dump;
  47 }
  48 foo({});
  49 ok(1, "[perl #38612]"); # Still no core dump? We are fine.
  50
  51 {
  52     my %h = (1,2,3,4);
  53     each %h;
  54
  55     my $d = Data::Dumper->new([\%h]);
  56     $d->Useqq(1);
  57     my $txt = $d->Dump();
  58     my $VAR1;
  59     eval $txt;
  60     is_deeply($VAR1, \%h, '[perl #40668] Reset hash iterator');
  61 }
  62
  63 # [perl #64744] Data::Dumper each() bad interaction
  64 {
  65     local $Data::Dumper::Useqq = 1;
  66     my $a = {foo => 1, bar => 1};
  67     each %$a;
  68     $a = {x => $a};
  69
  70     my $d = Data::Dumper->new([$a]);
  71     $d->Useqq(1);
  72     my $txt = $d->Dump();
  73     my $VAR1;
  74     eval $txt;
  75     is_deeply($VAR1, $a, '[perl #64744] Reset hash iterator');
  76 }
  77
  78 # [perl #56766] Segfaults on bad syntax - fixed with version 2.121_17
  79 sub doh
  80 {
  81     # 2nd arg is supposed to be an arrayref
  82     my $doh = Data::Dumper->Dump([\@_],'@_');
  83 }
  84 doh('fixed');
  85 ok(1, "[perl #56766]"); # Still no core dump? We are fine.
  86
  87 # EOF