This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #128524) correct indentation for utf-8 key hash elements
[perl5.git] / dist / Data-Dumper / t / bugs.t
1 #!perl
2 #
3 # regression tests for old bugs that do not 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 => 23;
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 {
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 { # https://rt.perl.org/Ticket/Display.html?id=128524
148     my $want;
149     my $runtime = "runtime";
150     my $requires = "requires";
151     utf8::upgrade(my $uruntime = $runtime);
152     utf8::upgrade(my $urequires = $requires);
153     for my $run ($runtime, $uruntime) {
154         for my $req ($requires, $urequires) {
155             my $data = { $run => { $req => { foo => "bar" } } };
156             local $Data::Dumper::Useperl = 1;
157             # we want them all the same
158             defined $want or $want = Dumper($data);
159             is(Dumper( $data ), $want, "utf-8 indents");
160           SKIP:
161             {
162                 defined &Data::Dumper::Dumpxs
163                   or skip "No XS available", 1;
164                 local $Data::Dumper::Useperl = 0;
165                 is(Dumper( $data ), $want, "utf8-indents");
166             }
167         }
168     }
169 }
170
171 # EOF