Commit | Line | Data |
---|---|---|
dd85fe9f RGS |
1 | #!perl |
2 | # | |
3 | # regression tests for old bugs that don't fit other categories | |
4 | ||
5 | BEGIN { | |
f8e2702e NC |
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; | |
dd85fe9f RGS |
11 | } |
12 | } | |
13 | ||
14 | use strict; | |
95869c09 | 15 | use Test::More tests => 13; |
dd85fe9f RGS |
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 | } | |
a8201472 JH |
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 | ||
d6686524 JH |
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; | |
b36d99fa AV |
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'); | |
d6686524 | 72 | } |
85d2acea JH |
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 | ||
3cea328d | 83 | SKIP: { |
49135aa5 | 84 | skip "perl 5.10.1 crashes and DD cannot help it", 1 if $] < 5.0119999; |
3cea328d FC |
85 | # [perl #72332] Segfault on empty-string glob |
86 | Data::Dumper->Dump([*{*STDERR{IO}}]); | |
87 | ok("ok", #ok | |
ecf0432f | 88 | "empty-string glob [perl #72332]"); |
3cea328d | 89 | } |
ecf0432f | 90 | |
7d3a730e NT |
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 | ||
95869c09 FC |
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 | is eval Dumper(\*{chr 256}), \*{chr 256}, | |
113 | 'GVs with UTF8 names (or not, depending on perl version)'; | |
114 | is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256}, | |
115 | 'GVs with UTF8 and nulls'; | |
116 | }; | |
117 | SKIP: { | |
118 | skip "no XS", 3 if not defined &Data::Dumper::Dumpxs; | |
119 | local $Data::Dumper::Useperl = 0; | |
120 | &$tests; | |
121 | } | |
122 | local $Data::Dumper::Useperl = 1; | |
123 | &$tests; | |
124 | } | |
125 | ||
85d2acea | 126 | # EOF |