1#!perl 2# 3# regression tests for old bugs that do not fit other categories 4 5BEGIN { 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 14use strict; 15use Test::More tests => 15; 16use 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 34sub 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} 44foo({}); 45ok(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 75sub doh 76{ 77 # 2nd arg is supposed to be an arrayref 78 my $doh = Data::Dumper->Dump([\@_],'@_'); 79} 80doh('fixed'); 81ok(1, "[perl #56766]"); # Still no core dump? We are fine. 82 83SKIP: { 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 92SKIP: { 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 148