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