Commit | Line | Data |
---|---|---|
823edd99 GS |
1 | #!./perl -w |
2 | # | |
3 | # testsuite for Data::Dumper | |
4 | # | |
5 | ||
6 | BEGIN { | |
f8e2702e NC |
7 | require Config; import Config; |
8 | if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { | |
9 | print "1..0 # Skip: Data::Dumper was not built\n"; | |
10 | exit 0; | |
be3174d2 | 11 | } |
823edd99 GS |
12 | } |
13 | ||
504f80c1 JH |
14 | # Since Perl 5.8.1 because otherwise hash ordering is really random. |
15 | local $Data::Dumper::Sortkeys = 1; | |
16 | ||
823edd99 | 17 | use Data::Dumper; |
f70c35af GS |
18 | use Config; |
19 | my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define'; | |
823edd99 GS |
20 | |
21 | $Data::Dumper::Pad = "#"; | |
22 | my $TMAX; | |
23 | my $XS; | |
24 | my $TNUM = 0; | |
25 | my $WANT = ''; | |
26 | ||
27 | sub TEST { | |
28 | my $string = shift; | |
c4cce848 | 29 | my $name = shift; |
823edd99 GS |
30 | my $t = eval $string; |
31 | ++$TNUM; | |
a2126434 | 32 | $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g |
c7780833 | 33 | if ($WANT =~ /deadbeef/); |
f70c35af | 34 | if ($Is_ebcdic) { |
c7780833 JK |
35 | # these data need massaging with non ascii character sets |
36 | # because of hashing order differences | |
37 | $WANT = join("\n",sort(split(/\n/,$WANT))); | |
38 | $WANT =~ s/\,$//mg; | |
39 | $t = join("\n",sort(split(/\n/,$t))); | |
40 | $t =~ s/\,$//mg; | |
f70c35af | 41 | } |
c4cce848 NC |
42 | $name = $name ? " - $name" : ''; |
43 | print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n" | |
c7780833 | 44 | : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n"); |
823edd99 GS |
45 | |
46 | ++$TNUM; | |
cf0d1c66 | 47 | if ($Is_ebcdic) { # EBCDIC. |
c7780833 JK |
48 | if ($TNUM == 311 || $TNUM == 314) { |
49 | eval $string; | |
50 | } else { | |
51 | eval $t; | |
52 | } | |
cf0d1c66 | 53 | } else { |
c7780833 | 54 | eval "$t"; |
cf0d1c66 | 55 | } |
823edd99 GS |
56 | print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n"; |
57 | ||
58 | $t = eval $string; | |
59 | ++$TNUM; | |
a2126434 | 60 | $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g |
c7780833 | 61 | if ($WANT =~ /deadbeef/); |
f70c35af | 62 | if ($Is_ebcdic) { |
c7780833 JK |
63 | # here too there are hashing order differences |
64 | $WANT = join("\n",sort(split(/\n/,$WANT))); | |
65 | $WANT =~ s/\,$//mg; | |
66 | $t = join("\n",sort(split(/\n/,$t))); | |
67 | $t =~ s/\,$//mg; | |
f70c35af | 68 | } |
823edd99 | 69 | print( ($t eq $WANT and not $@) ? "ok $TNUM\n" |
c7780833 | 70 | : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); |
823edd99 GS |
71 | } |
72 | ||
fec5e1eb IM |
73 | sub SKIP_TEST { |
74 | my $reason = shift; | |
75 | ++$TNUM; print "ok $TNUM # skip $reason\n"; | |
76 | ++$TNUM; print "ok $TNUM # skip $reason\n"; | |
77 | ++$TNUM; print "ok $TNUM # skip $reason\n"; | |
78 | } | |
79 | ||
c4cce848 NC |
80 | # Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling |
81 | # it direct. Out here it lets us knobble the next if to test that the perl | |
82 | # only tests do work (and count correctly) | |
83 | $Data::Dumper::Useperl = 1; | |
823edd99 GS |
84 | if (defined &Data::Dumper::Dumpxs) { |
85 | print "### XS extension loaded, will run XS tests\n"; | |
b183d514 | 86 | $TMAX = 432; $XS = 1; |
823edd99 GS |
87 | } |
88 | else { | |
89 | print "### XS extensions not loaded, will NOT run XS tests\n"; | |
b183d514 | 90 | $TMAX = 216; $XS = 0; |
823edd99 GS |
91 | } |
92 | ||
93 | print "1..$TMAX\n"; | |
94 | ||
c4cce848 | 95 | #XXXif (0) { |
823edd99 GS |
96 | ############# |
97 | ############# | |
98 | ||
99 | @c = ('c'); | |
100 | $c = \@c; | |
101 | $b = {}; | |
102 | $a = [1, $b, $c]; | |
103 | $b->{a} = $a; | |
104 | $b->{b} = $a->[1]; | |
105 | $b->{c} = $a->[2]; | |
106 | ||
107 | ############# 1 | |
108 | ## | |
109 | $WANT = <<'EOT'; | |
110 | #$a = [ | |
111 | # 1, | |
112 | # { | |
504f80c1 JH |
113 | # 'a' => $a, |
114 | # 'b' => $a->[1], | |
823edd99 GS |
115 | # 'c' => [ |
116 | # 'c' | |
504f80c1 | 117 | # ] |
823edd99 GS |
118 | # }, |
119 | # $a->[1]{'c'} | |
120 | # ]; | |
121 | #$b = $a->[1]; | |
d20128b8 | 122 | #$6 = $a->[1]{'c'}; |
823edd99 GS |
123 | EOT |
124 | ||
c7780833 JK |
125 | TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])), |
126 | 'basic test with names: Dump()'); | |
127 | TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])), | |
128 | 'basic test with names: Dumpxs()') | |
129 | if $XS; | |
823edd99 | 130 | |
d424882c | 131 | SCOPE: { |
c7780833 JK |
132 | local $Data::Dumper::Sparseseen = 1; |
133 | TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])), | |
134 | 'Sparseseen with names: Dump()'); | |
135 | TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])), | |
136 | 'Sparseseen with names: Dumpxs()') | |
137 | if $XS; | |
d424882c | 138 | } |
823edd99 | 139 | |
c7780833 | 140 | |
823edd99 GS |
141 | ############# 7 |
142 | ## | |
143 | $WANT = <<'EOT'; | |
144 | #@a = ( | |
145 | # 1, | |
146 | # { | |
504f80c1 JH |
147 | # 'a' => [], |
148 | # 'b' => {}, | |
823edd99 GS |
149 | # 'c' => [ |
150 | # 'c' | |
504f80c1 | 151 | # ] |
823edd99 GS |
152 | # }, |
153 | # [] | |
154 | # ); | |
155 | #$a[1]{'a'} = \@a; | |
156 | #$a[1]{'b'} = $a[1]; | |
157 | #$a[2] = $a[1]{'c'}; | |
158 | #$b = $a[1]; | |
159 | EOT | |
160 | ||
161 | $Data::Dumper::Purity = 1; # fill in the holes for eval | |
c7780833 JK |
162 | TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])), |
163 | 'Purity: basic test with dereferenced array: Dump()'); # print as @a | |
164 | TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])), | |
165 | 'Purity: basic test with dereferenced array: Dumpxs()') | |
166 | if $XS; | |
823edd99 | 167 | |
d424882c S |
168 | SCOPE: { |
169 | local $Data::Dumper::Sparseseen = 1; | |
c7780833 JK |
170 | TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])), |
171 | 'Purity: Sparseseen with dereferenced array: Dump()'); # print as @a | |
172 | TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])), | |
173 | 'Purity: Sparseseen with dereferenced array: Dumpxs()') | |
174 | if $XS; | |
d424882c S |
175 | } |
176 | ||
823edd99 GS |
177 | ############# 13 |
178 | ## | |
179 | $WANT = <<'EOT'; | |
180 | #%b = ( | |
181 | # 'a' => [ | |
182 | # 1, | |
183 | # {}, | |
504f80c1 JH |
184 | # [ |
185 | # 'c' | |
186 | # ] | |
823edd99 | 187 | # ], |
504f80c1 JH |
188 | # 'b' => {}, |
189 | # 'c' => [] | |
823edd99 GS |
190 | # ); |
191 | #$b{'a'}[1] = \%b; | |
192 | #$b{'b'} = \%b; | |
504f80c1 | 193 | #$b{'c'} = $b{'a'}[2]; |
823edd99 GS |
194 | #$a = $b{'a'}; |
195 | EOT | |
196 | ||
c7780833 JK |
197 | TEST (q(Data::Dumper->Dump([$b, $a], [qw(*b a)])), |
198 | 'basic test with dereferenced hash: Dump()'); # print as %b | |
199 | TEST (q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])), | |
200 | 'basic test with dereferenced hash: Dumpxs()') | |
201 | if $XS; | |
823edd99 GS |
202 | |
203 | ############# 19 | |
204 | ## | |
205 | $WANT = <<'EOT'; | |
206 | #$a = [ | |
207 | # 1, | |
208 | # { | |
209 | # 'a' => [], | |
504f80c1 JH |
210 | # 'b' => {}, |
211 | # 'c' => [] | |
823edd99 GS |
212 | # }, |
213 | # [] | |
214 | #]; | |
215 | #$a->[1]{'a'} = $a; | |
216 | #$a->[1]{'b'} = $a->[1]; | |
504f80c1 | 217 | #$a->[1]{'c'} = \@c; |
823edd99 GS |
218 | #$a->[2] = \@c; |
219 | #$b = $a->[1]; | |
220 | EOT | |
221 | ||
222 | $Data::Dumper::Indent = 1; | |
c7780833 | 223 | TEST (q( |
823edd99 GS |
224 | $d = Data::Dumper->new([$a,$b], [qw(a b)]); |
225 | $d->Seen({'*c' => $c}); | |
226 | $d->Dump; | |
c7780833 JK |
227 | ), |
228 | 'Indent: Seen: Dump()'); | |
823edd99 | 229 | if ($XS) { |
c7780833 | 230 | TEST (q( |
823edd99 GS |
231 | $d = Data::Dumper->new([$a,$b], [qw(a b)]); |
232 | $d->Seen({'*c' => $c}); | |
233 | $d->Dumpxs; | |
c7780833 JK |
234 | ), |
235 | 'Indent: Seen: Dumpxs()'); | |
823edd99 GS |
236 | } |
237 | ||
238 | ||
239 | ############# 25 | |
240 | ## | |
241 | $WANT = <<'EOT'; | |
242 | #$a = [ | |
243 | # #0 | |
244 | # 1, | |
245 | # #1 | |
246 | # { | |
504f80c1 JH |
247 | # a => $a, |
248 | # b => $a->[1], | |
823edd99 GS |
249 | # c => [ |
250 | # #0 | |
251 | # 'c' | |
504f80c1 | 252 | # ] |
823edd99 GS |
253 | # }, |
254 | # #2 | |
255 | # $a->[1]{c} | |
256 | # ]; | |
257 | #$b = $a->[1]; | |
258 | EOT | |
259 | ||
260 | $d->Indent(3); | |
261 | $d->Purity(0)->Quotekeys(0); | |
c7780833 JK |
262 | TEST (q( $d->Reset; $d->Dump ), |
263 | 'Indent(3): Purity(0)->Quotekeys(0): Dump()'); | |
823edd99 | 264 | |
c7780833 JK |
265 | TEST (q( $d->Reset; $d->Dumpxs ), |
266 | 'Indent(3): Purity(0)->Quotekeys(0): Dumpxs()') | |
267 | if $XS; | |
823edd99 GS |
268 | |
269 | ############# 31 | |
270 | ## | |
271 | $WANT = <<'EOT'; | |
272 | #$VAR1 = [ | |
273 | # 1, | |
274 | # { | |
504f80c1 JH |
275 | # 'a' => [], |
276 | # 'b' => {}, | |
823edd99 GS |
277 | # 'c' => [ |
278 | # 'c' | |
504f80c1 | 279 | # ] |
823edd99 GS |
280 | # }, |
281 | # [] | |
282 | #]; | |
283 | #$VAR1->[1]{'a'} = $VAR1; | |
284 | #$VAR1->[1]{'b'} = $VAR1->[1]; | |
285 | #$VAR1->[2] = $VAR1->[1]{'c'}; | |
286 | EOT | |
287 | ||
c7780833 JK |
288 | TEST (q(Dumper($a)), 'Dumper'); |
289 | TEST (q(Data::Dumper::DumperX($a)), 'DumperX') if $XS; | |
823edd99 GS |
290 | |
291 | ############# 37 | |
292 | ## | |
293 | $WANT = <<'EOT'; | |
294 | #[ | |
295 | # 1, | |
296 | # { | |
504f80c1 JH |
297 | # a => $VAR1, |
298 | # b => $VAR1->[1], | |
823edd99 GS |
299 | # c => [ |
300 | # 'c' | |
504f80c1 | 301 | # ] |
823edd99 GS |
302 | # }, |
303 | # $VAR1->[1]{c} | |
304 | #] | |
305 | EOT | |
306 | ||
307 | { | |
308 | local $Data::Dumper::Purity = 0; | |
309 | local $Data::Dumper::Quotekeys = 0; | |
310 | local $Data::Dumper::Terse = 1; | |
c7780833 JK |
311 | TEST (q(Dumper($a)), |
312 | 'Purity 0: Quotekeys 0: Terse 1: Dumper'); | |
313 | TEST (q(Data::Dumper::DumperX($a)), | |
314 | 'Purity 0: Quotekeys 0: Terse 1: DumperX') | |
315 | if $XS; | |
823edd99 GS |
316 | } |
317 | ||
318 | ||
319 | ############# 43 | |
320 | ## | |
321 | $WANT = <<'EOT'; | |
322 | #$VAR1 = { | |
504f80c1 JH |
323 | # "abc\0'\efg" => "mno\0", |
324 | # "reftest" => \\1 | |
823edd99 GS |
325 | #}; |
326 | EOT | |
327 | ||
54964f74 GA |
328 | $foo = { "abc\000\'\efg" => "mno\000", |
329 | "reftest" => \\1, | |
330 | }; | |
823edd99 GS |
331 | { |
332 | local $Data::Dumper::Useqq = 1; | |
c7780833 JK |
333 | TEST (q(Dumper($foo)), 'Useqq: Dumper'); |
334 | TEST (q(Data::Dumper::DumperX($foo)), 'Useqq: DumperX') if $XS; | |
823edd99 GS |
335 | } |
336 | ||
823edd99 GS |
337 | |
338 | ||
339 | ############# | |
340 | ############# | |
341 | ||
342 | { | |
343 | package main; | |
344 | use Data::Dumper; | |
345 | $foo = 5; | |
f32b5c8a | 346 | @foo = (-10,\*foo); |
823edd99 GS |
347 | %foo = (a=>1,b=>\$foo,c=>\@foo); |
348 | $foo{d} = \%foo; | |
349 | $foo[2] = \%foo; | |
350 | ||
351 | ############# 49 | |
352 | ## | |
353 | $WANT = <<'EOT'; | |
354 | #$foo = \*::foo; | |
355 | #*::foo = \5; | |
356 | #*::foo = [ | |
357 | # #0 | |
f32b5c8a | 358 | # -10, |
823edd99 | 359 | # #1 |
5df59fb6 | 360 | # do{my $o}, |
823edd99 GS |
361 | # #2 |
362 | # { | |
363 | # 'a' => 1, | |
5df59fb6 | 364 | # 'b' => do{my $o}, |
504f80c1 | 365 | # 'c' => [], |
823edd99 GS |
366 | # 'd' => {} |
367 | # } | |
368 | # ]; | |
369 | #*::foo{ARRAY}->[1] = $foo; | |
a6fe520e | 370 | #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR}; |
504f80c1 | 371 | #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY}; |
823edd99 GS |
372 | #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2]; |
373 | #*::foo = *::foo{ARRAY}->[2]; | |
374 | #@bar = @{*::foo{ARRAY}}; | |
375 | #%baz = %{*::foo{ARRAY}->[2]}; | |
376 | EOT | |
377 | ||
378 | $Data::Dumper::Purity = 1; | |
379 | $Data::Dumper::Indent = 3; | |
c7780833 JK |
380 | TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), |
381 | 'Purity 1: Indent 3: Dump()'); | |
382 | TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), | |
383 | 'Purity 1: Indent 3: Dumpxs()') | |
384 | if $XS; | |
823edd99 GS |
385 | |
386 | ############# 55 | |
387 | ## | |
388 | $WANT = <<'EOT'; | |
389 | #$foo = \*::foo; | |
390 | #*::foo = \5; | |
391 | #*::foo = [ | |
f32b5c8a | 392 | # -10, |
5df59fb6 | 393 | # do{my $o}, |
823edd99 GS |
394 | # { |
395 | # 'a' => 1, | |
5df59fb6 | 396 | # 'b' => do{my $o}, |
504f80c1 | 397 | # 'c' => [], |
823edd99 GS |
398 | # 'd' => {} |
399 | # } | |
400 | #]; | |
401 | #*::foo{ARRAY}->[1] = $foo; | |
a6fe520e | 402 | #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR}; |
504f80c1 | 403 | #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY}; |
823edd99 GS |
404 | #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2]; |
405 | #*::foo = *::foo{ARRAY}->[2]; | |
406 | #$bar = *::foo{ARRAY}; | |
407 | #$baz = *::foo{ARRAY}->[2]; | |
408 | EOT | |
409 | ||
410 | $Data::Dumper::Indent = 1; | |
c7780833 JK |
411 | TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), |
412 | 'Purity 1: Indent 1: Dump()'); | |
413 | TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), | |
414 | 'Purity 1: Indent 1: Dumpxs()') | |
415 | if $XS; | |
823edd99 GS |
416 | |
417 | ############# 61 | |
418 | ## | |
419 | $WANT = <<'EOT'; | |
420 | #@bar = ( | |
f32b5c8a | 421 | # -10, |
823edd99 GS |
422 | # \*::foo, |
423 | # {} | |
424 | #); | |
425 | #*::foo = \5; | |
426 | #*::foo = \@bar; | |
427 | #*::foo = { | |
428 | # 'a' => 1, | |
5df59fb6 | 429 | # 'b' => do{my $o}, |
504f80c1 | 430 | # 'c' => [], |
823edd99 GS |
431 | # 'd' => {} |
432 | #}; | |
a6fe520e | 433 | #*::foo{HASH}->{'b'} = *::foo{SCALAR}; |
504f80c1 | 434 | #*::foo{HASH}->{'c'} = \@bar; |
823edd99 GS |
435 | #*::foo{HASH}->{'d'} = *::foo{HASH}; |
436 | #$bar[2] = *::foo{HASH}; | |
437 | #%baz = %{*::foo{HASH}}; | |
438 | #$foo = $bar[1]; | |
439 | EOT | |
440 | ||
c7780833 JK |
441 | TEST (q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])), |
442 | 'array|hash|glob dereferenced: Dump()'); | |
443 | TEST (q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])), | |
444 | 'array|hash|glob dereferenced: Dumpxs()') | |
445 | if $XS; | |
823edd99 GS |
446 | |
447 | ############# 67 | |
448 | ## | |
449 | $WANT = <<'EOT'; | |
450 | #$bar = [ | |
f32b5c8a | 451 | # -10, |
823edd99 GS |
452 | # \*::foo, |
453 | # {} | |
454 | #]; | |
455 | #*::foo = \5; | |
456 | #*::foo = $bar; | |
457 | #*::foo = { | |
458 | # 'a' => 1, | |
5df59fb6 | 459 | # 'b' => do{my $o}, |
504f80c1 | 460 | # 'c' => [], |
823edd99 GS |
461 | # 'd' => {} |
462 | #}; | |
a6fe520e | 463 | #*::foo{HASH}->{'b'} = *::foo{SCALAR}; |
504f80c1 | 464 | #*::foo{HASH}->{'c'} = $bar; |
823edd99 GS |
465 | #*::foo{HASH}->{'d'} = *::foo{HASH}; |
466 | #$bar->[2] = *::foo{HASH}; | |
467 | #$baz = *::foo{HASH}; | |
468 | #$foo = $bar->[1]; | |
469 | EOT | |
470 | ||
c7780833 JK |
471 | TEST (q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])), |
472 | 'array|hash|glob: not dereferenced: Dump()'); | |
473 | TEST (q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])), | |
474 | 'array|hash|glob: not dereferenced: Dumpxs()') | |
475 | if $XS; | |
823edd99 GS |
476 | |
477 | ############# 73 | |
478 | ## | |
479 | $WANT = <<'EOT'; | |
480 | #$foo = \*::foo; | |
481 | #@bar = ( | |
f32b5c8a | 482 | # -10, |
823edd99 GS |
483 | # $foo, |
484 | # { | |
485 | # a => 1, | |
486 | # b => \5, | |
504f80c1 | 487 | # c => \@bar, |
823edd99 GS |
488 | # d => $bar[2] |
489 | # } | |
490 | #); | |
491 | #%baz = %{$bar[2]}; | |
492 | EOT | |
493 | ||
494 | $Data::Dumper::Purity = 0; | |
495 | $Data::Dumper::Quotekeys = 0; | |
c7780833 JK |
496 | TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), |
497 | 'Purity 0: Quotekeys 0: dereferenced: Dump()'); | |
498 | TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), | |
499 | 'Purity 0: Quotekeys 0: dereferenced: Dumpxs') | |
500 | if $XS; | |
823edd99 GS |
501 | |
502 | ############# 79 | |
503 | ## | |
504 | $WANT = <<'EOT'; | |
505 | #$foo = \*::foo; | |
506 | #$bar = [ | |
f32b5c8a | 507 | # -10, |
823edd99 GS |
508 | # $foo, |
509 | # { | |
510 | # a => 1, | |
511 | # b => \5, | |
504f80c1 | 512 | # c => $bar, |
823edd99 GS |
513 | # d => $bar->[2] |
514 | # } | |
515 | #]; | |
516 | #$baz = $bar->[2]; | |
517 | EOT | |
518 | ||
c7780833 JK |
519 | TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), |
520 | 'Purity 0: Quotekeys 0: not dereferenced: Dump()'); | |
521 | TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), | |
522 | 'Purity 0: Quotekeys 0: not dereferenced: Dumpxs()') | |
523 | if $XS; | |
823edd99 GS |
524 | |
525 | } | |
526 | ||
527 | ############# | |
528 | ############# | |
529 | { | |
530 | package main; | |
531 | @dogs = ( 'Fido', 'Wags' ); | |
532 | %kennel = ( | |
533 | First => \$dogs[0], | |
534 | Second => \$dogs[1], | |
535 | ); | |
536 | $dogs[2] = \%kennel; | |
537 | $mutts = \%kennel; | |
538 | $mutts = $mutts; # avoid warning | |
3bd791fa | 539 | |
823edd99 GS |
540 | ############# 85 |
541 | ## | |
542 | $WANT = <<'EOT'; | |
543 | #%kennels = ( | |
504f80c1 JH |
544 | # First => \'Fido', |
545 | # Second => \'Wags' | |
823edd99 GS |
546 | #); |
547 | #@dogs = ( | |
0f4592ef GS |
548 | # ${$kennels{First}}, |
549 | # ${$kennels{Second}}, | |
823edd99 GS |
550 | # \%kennels |
551 | #); | |
552 | #%mutts = %kennels; | |
553 | EOT | |
554 | ||
c7780833 | 555 | TEST (q( |
823edd99 GS |
556 | $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts], |
557 | [qw(*kennels *dogs *mutts)] ); | |
558 | $d->Dump; | |
c7780833 JK |
559 | ), |
560 | 'constructor: hash|array|scalar: Dump()'); | |
823edd99 | 561 | if ($XS) { |
c7780833 | 562 | TEST (q( |
823edd99 GS |
563 | $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts], |
564 | [qw(*kennels *dogs *mutts)] ); | |
565 | $d->Dumpxs; | |
c7780833 JK |
566 | ), |
567 | 'constructor: hash|array|scalar: Dumpxs()'); | |
823edd99 | 568 | } |
3bd791fa | 569 | |
823edd99 GS |
570 | ############# 91 |
571 | ## | |
572 | $WANT = <<'EOT'; | |
573 | #%kennels = %kennels; | |
574 | #@dogs = @dogs; | |
575 | #%mutts = %kennels; | |
576 | EOT | |
577 | ||
c7780833 JK |
578 | TEST q($d->Dump), 'object call: Dump'; |
579 | TEST q($d->Dumpxs), 'object call: Dumpxs' if $XS; | |
3bd791fa | 580 | |
823edd99 GS |
581 | ############# 97 |
582 | ## | |
583 | $WANT = <<'EOT'; | |
584 | #%kennels = ( | |
504f80c1 JH |
585 | # First => \'Fido', |
586 | # Second => \'Wags' | |
823edd99 GS |
587 | #); |
588 | #@dogs = ( | |
0f4592ef GS |
589 | # ${$kennels{First}}, |
590 | # ${$kennels{Second}}, | |
823edd99 GS |
591 | # \%kennels |
592 | #); | |
593 | #%mutts = %kennels; | |
594 | EOT | |
595 | ||
c7780833 | 596 | TEST q($d->Reset; $d->Dump), 'Reset and Dump separate calls'; |
823edd99 | 597 | if ($XS) { |
c7780833 | 598 | TEST (q($d->Reset; $d->Dumpxs), 'Reset and Dumpxs separate calls'); |
823edd99 GS |
599 | } |
600 | ||
601 | ############# 103 | |
602 | ## | |
603 | $WANT = <<'EOT'; | |
604 | #@dogs = ( | |
605 | # 'Fido', | |
606 | # 'Wags', | |
607 | # { | |
504f80c1 JH |
608 | # First => \$dogs[0], |
609 | # Second => \$dogs[1] | |
823edd99 GS |
610 | # } |
611 | #); | |
612 | #%kennels = %{$dogs[2]}; | |
613 | #%mutts = %{$dogs[2]}; | |
614 | EOT | |
615 | ||
c7780833 | 616 | TEST (q( |
823edd99 GS |
617 | $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts], |
618 | [qw(*dogs *kennels *mutts)] ); | |
619 | $d->Dump; | |
c7780833 JK |
620 | ), |
621 | 'constructor: array|hash|scalar: Dump()'); | |
823edd99 | 622 | if ($XS) { |
c7780833 | 623 | TEST (q( |
823edd99 GS |
624 | $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts], |
625 | [qw(*dogs *kennels *mutts)] ); | |
626 | $d->Dumpxs; | |
c7780833 JK |
627 | ), |
628 | 'constructor: array|hash|scalar: Dumpxs()'); | |
823edd99 | 629 | } |
3bd791fa | 630 | |
823edd99 GS |
631 | ############# 109 |
632 | ## | |
c7780833 | 633 | TEST q($d->Reset->Dump), 'Reset Dump chained'; |
823edd99 | 634 | if ($XS) { |
c7780833 | 635 | TEST q($d->Reset->Dumpxs), 'Reset Dumpxs chained'; |
823edd99 GS |
636 | } |
637 | ||
638 | ############# 115 | |
639 | ## | |
640 | $WANT = <<'EOT'; | |
641 | #@dogs = ( | |
642 | # 'Fido', | |
643 | # 'Wags', | |
644 | # { | |
504f80c1 JH |
645 | # First => \'Fido', |
646 | # Second => \'Wags' | |
823edd99 GS |
647 | # } |
648 | #); | |
649 | #%kennels = ( | |
504f80c1 JH |
650 | # First => \'Fido', |
651 | # Second => \'Wags' | |
823edd99 GS |
652 | #); |
653 | EOT | |
654 | ||
c7780833 | 655 | TEST (q( |
823edd99 GS |
656 | $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] ); |
657 | $d->Deepcopy(1)->Dump; | |
c7780833 JK |
658 | ), |
659 | 'Deepcopy(1): Dump'); | |
823edd99 | 660 | if ($XS) { |
c7780833 JK |
661 | # TEST 'q($d->Reset->Dumpxs); |
662 | TEST (q( | |
663 | $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] ); | |
664 | $d->Deepcopy(1)->Dumpxs; | |
665 | ), | |
666 | 'Deepcopy(1): Dumpxs'); | |
823edd99 | 667 | } |
3bd791fa | 668 | |
823edd99 GS |
669 | } |
670 | ||
671 | { | |
672 | ||
0f4592ef GS |
673 | sub z { print "foo\n" } |
674 | $c = [ \&z ]; | |
823edd99 GS |
675 | |
676 | ############# 121 | |
677 | ## | |
678 | $WANT = <<'EOT'; | |
679 | #$a = $b; | |
680 | #$c = [ | |
681 | # $b | |
682 | #]; | |
683 | EOT | |
684 | ||
c7780833 JK |
685 | TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;), |
686 | 'Seen: scalar: Dump'); | |
687 | TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;), | |
688 | 'Seen: scalar: Dumpxs') | |
823edd99 GS |
689 | if $XS; |
690 | ||
691 | ############# 127 | |
692 | ## | |
693 | $WANT = <<'EOT'; | |
694 | #$a = \&b; | |
695 | #$c = [ | |
696 | # \&b | |
697 | #]; | |
698 | EOT | |
699 | ||
c7780833 JK |
700 | TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;), |
701 | 'Seen: glob: Dump'); | |
702 | TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;), | |
703 | 'Seen: glob: Dumpxs') | |
823edd99 GS |
704 | if $XS; |
705 | ||
706 | ############# 133 | |
707 | ## | |
708 | $WANT = <<'EOT'; | |
709 | #*a = \&b; | |
710 | #@c = ( | |
711 | # \&b | |
712 | #); | |
713 | EOT | |
714 | ||
c7780833 JK |
715 | TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;), |
716 | 'Seen: glob: dereference: Dump'); | |
717 | TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => | |
718 | \&z})->Dumpxs;), | |
719 | 'Seen: glob: derference: Dumpxs') | |
823edd99 GS |
720 | if $XS; |
721 | ||
722 | } | |
0f4592ef GS |
723 | |
724 | { | |
725 | $a = []; | |
726 | $a->[1] = \$a->[0]; | |
727 | ||
728 | ############# 139 | |
729 | ## | |
730 | $WANT = <<'EOT'; | |
731 | #@a = ( | |
732 | # undef, | |
5df59fb6 | 733 | # do{my $o} |
0f4592ef GS |
734 | #); |
735 | #$a[1] = \$a[0]; | |
736 | EOT | |
737 | ||
c7780833 JK |
738 | TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;), |
739 | 'Purity(1): dereference: Dump'); | |
740 | TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;), | |
741 | 'Purity(1): dereference: Dumpxs') | |
0f4592ef GS |
742 | if $XS; |
743 | } | |
744 | ||
745 | { | |
746 | $a = \\\\\'foo'; | |
747 | $b = $$$a; | |
748 | ||
749 | ############# 145 | |
750 | ## | |
751 | $WANT = <<'EOT'; | |
752 | #$a = \\\\\'foo'; | |
753 | #$b = ${${$a}}; | |
754 | EOT | |
755 | ||
c7780833 JK |
756 | TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;), |
757 | 'Purity(1): not dereferenced: Dump'); | |
758 | TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;), | |
759 | 'Purity(1): not dereferenced: Dumpxs') | |
0f4592ef GS |
760 | if $XS; |
761 | } | |
762 | ||
763 | { | |
764 | $a = [{ a => \$b }, { b => undef }]; | |
765 | $b = [{ c => \$b }, { d => \$a }]; | |
766 | ||
767 | ############# 151 | |
768 | ## | |
769 | $WANT = <<'EOT'; | |
770 | #$a = [ | |
771 | # { | |
772 | # a => \[ | |
773 | # { | |
5df59fb6 | 774 | # c => do{my $o} |
0f4592ef GS |
775 | # }, |
776 | # { | |
777 | # d => \[] | |
778 | # } | |
779 | # ] | |
780 | # }, | |
781 | # { | |
782 | # b => undef | |
783 | # } | |
784 | #]; | |
785 | #${$a->[0]{a}}->[0]->{c} = $a->[0]{a}; | |
786 | #${${$a->[0]{a}}->[1]->{d}} = $a; | |
787 | #$b = ${$a->[0]{a}}; | |
788 | EOT | |
789 | ||
c7780833 JK |
790 | TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;), |
791 | 'Purity(1): Dump again'); | |
792 | TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;), | |
793 | 'Purity(1); Dumpxs again') | |
0f4592ef GS |
794 | if $XS; |
795 | } | |
796 | ||
797 | { | |
798 | $a = [[[[\\\\\'foo']]]]; | |
799 | $b = $a->[0][0]; | |
800 | $c = $${$b->[0][0]}; | |
801 | ||
802 | ############# 157 | |
803 | ## | |
804 | $WANT = <<'EOT'; | |
805 | #$a = [ | |
806 | # [ | |
807 | # [ | |
808 | # [ | |
809 | # \\\\\'foo' | |
810 | # ] | |
811 | # ] | |
812 | # ] | |
813 | #]; | |
814 | #$b = $a->[0][0]; | |
815 | #$c = ${${$a->[0][0][0][0]}}; | |
816 | EOT | |
817 | ||
c7780833 JK |
818 | TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;), |
819 | 'Purity(1): Dump: 3 elements'); | |
820 | TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;), | |
821 | 'Purity(1): Dumpxs: 3 elements') | |
0f4592ef GS |
822 | if $XS; |
823 | } | |
a2126434 JN |
824 | |
825 | { | |
826 | $f = "pearl"; | |
827 | $e = [ $f ]; | |
828 | $d = { 'e' => $e }; | |
829 | $c = [ $d ]; | |
830 | $b = { 'c' => $c }; | |
831 | $a = { 'b' => $b }; | |
832 | ||
833 | ############# 163 | |
834 | ## | |
835 | $WANT = <<'EOT'; | |
836 | #$a = { | |
837 | # b => { | |
838 | # c => [ | |
839 | # { | |
840 | # e => 'ARRAY(0xdeadbeef)' | |
841 | # } | |
842 | # ] | |
843 | # } | |
844 | #}; | |
845 | #$b = $a->{b}; | |
846 | #$c = $a->{b}{c}; | |
847 | EOT | |
848 | ||
c7780833 JK |
849 | TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;), |
850 | 'Maxdepth(4): Dump()'); | |
851 | TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;), | |
852 | 'Maxdepth(4): Dumpxs()') | |
a2126434 JN |
853 | if $XS; |
854 | ||
855 | ############# 169 | |
856 | ## | |
857 | $WANT = <<'EOT'; | |
858 | #$a = { | |
859 | # b => 'HASH(0xdeadbeef)' | |
860 | #}; | |
861 | #$b = $a->{b}; | |
862 | #$c = [ | |
863 | # 'HASH(0xdeadbeef)' | |
864 | #]; | |
865 | EOT | |
866 | ||
c7780833 JK |
867 | TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;), |
868 | 'Maxdepth(1): Dump()'); | |
869 | TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;), | |
870 | 'Maxdepth(1): Dumpxs()') | |
a2126434 JN |
871 | if $XS; |
872 | } | |
5df59fb6 GS |
873 | |
874 | { | |
875 | $a = \$a; | |
876 | $b = [$a]; | |
877 | ||
878 | ############# 175 | |
879 | ## | |
880 | $WANT = <<'EOT'; | |
881 | #$b = [ | |
882 | # \$b->[0] | |
883 | #]; | |
884 | EOT | |
885 | ||
c7780833 JK |
886 | TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;), |
887 | 'Purity(0): Dump()'); | |
888 | TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;), | |
889 | 'Purity(0): Dumpxs()') | |
5df59fb6 GS |
890 | if $XS; |
891 | ||
892 | ############# 181 | |
893 | ## | |
894 | $WANT = <<'EOT'; | |
895 | #$b = [ | |
896 | # \do{my $o} | |
897 | #]; | |
898 | #${$b->[0]} = $b->[0]; | |
899 | EOT | |
900 | ||
901 | ||
c7780833 JK |
902 | TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;), |
903 | 'Purity(1): Dump()'); | |
904 | TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;), | |
905 | 'Purity(1): Dumpxs') | |
5df59fb6 GS |
906 | if $XS; |
907 | } | |
f397e026 TC |
908 | |
909 | { | |
910 | $a = "\x{09c10}"; | |
911 | ############# 187 | |
912 | ## XS code was adding an extra \0 | |
913 | $WANT = <<'EOT'; | |
914 | #$a = "\x{9c10}"; | |
915 | EOT | |
916 | ||
fec5e1eb IM |
917 | if($] >= 5.007) { |
918 | TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}"; | |
919 | } else { | |
920 | SKIP_TEST "Incomplete support for UTF-8 in old perls"; | |
921 | } | |
c4cce848 NC |
922 | TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}" |
923 | if $XS; | |
f397e026 | 924 | } |
e9105f86 IN |
925 | |
926 | { | |
927 | $i = 0; | |
928 | $a = { map { ("$_$_$_", ++$i) } 'I'..'Q' }; | |
e9105f86 IN |
929 | |
930 | ############# 193 | |
931 | ## | |
932 | $WANT = <<'EOT'; | |
933 | #$VAR1 = { | |
934 | # III => 1, | |
935 | # JJJ => 2, | |
936 | # KKK => 3, | |
937 | # LLL => 4, | |
938 | # MMM => 5, | |
939 | # NNN => 6, | |
940 | # OOO => 7, | |
941 | # PPP => 8, | |
942 | # QQQ => 9 | |
943 | #}; | |
944 | EOT | |
945 | ||
c7780833 JK |
946 | TEST (q(Data::Dumper->new([$a])->Dump;), |
947 | 'basic test without names: Dump()'); | |
948 | TEST (q(Data::Dumper->new([$a])->Dumpxs;), | |
949 | 'basic test without names: Dumpxs()') | |
e9105f86 IN |
950 | if $XS; |
951 | } | |
952 | ||
953 | { | |
954 | $i = 5; | |
955 | $c = { map { (++$i, "$_$_$_") } 'I'..'Q' }; | |
956 | local $Data::Dumper::Sortkeys = \&sort199; | |
957 | sub sort199 { | |
958 | my $hash = shift; | |
959 | return [ sort { $b <=> $a } keys %$hash ]; | |
960 | } | |
961 | ||
962 | ############# 199 | |
963 | ## | |
964 | $WANT = <<'EOT'; | |
965 | #$VAR1 = { | |
c4cce848 NC |
966 | # 14 => 'QQQ', |
967 | # 13 => 'PPP', | |
968 | # 12 => 'OOO', | |
969 | # 11 => 'NNN', | |
970 | # 10 => 'MMM', | |
971 | # 9 => 'LLL', | |
972 | # 8 => 'KKK', | |
973 | # 7 => 'JJJ', | |
974 | # 6 => 'III' | |
e9105f86 IN |
975 | #}; |
976 | EOT | |
977 | ||
5b50ddc0 | 978 | TEST q(Data::Dumper->new([$c])->Dump;), "sortkeys sub"; |
c7780833 | 979 | TEST q(Data::Dumper->new([$c])->Dumpxs;), "sortkeys sub (XS)" |
e9105f86 IN |
980 | if $XS; |
981 | } | |
982 | ||
983 | { | |
984 | $i = 5; | |
985 | $c = { map { (++$i, "$_$_$_") } 'I'..'Q' }; | |
986 | $d = { reverse %$c }; | |
987 | local $Data::Dumper::Sortkeys = \&sort205; | |
988 | sub sort205 { | |
989 | my $hash = shift; | |
3bd791fa | 990 | return [ |
e9105f86 IN |
991 | $hash eq $c ? (sort { $a <=> $b } keys %$hash) |
992 | : (reverse sort keys %$hash) | |
993 | ]; | |
994 | } | |
995 | ||
996 | ############# 205 | |
997 | ## | |
998 | $WANT = <<'EOT'; | |
999 | #$VAR1 = [ | |
1000 | # { | |
c4cce848 NC |
1001 | # 6 => 'III', |
1002 | # 7 => 'JJJ', | |
1003 | # 8 => 'KKK', | |
1004 | # 9 => 'LLL', | |
1005 | # 10 => 'MMM', | |
1006 | # 11 => 'NNN', | |
1007 | # 12 => 'OOO', | |
1008 | # 13 => 'PPP', | |
1009 | # 14 => 'QQQ' | |
e9105f86 IN |
1010 | # }, |
1011 | # { | |
c4cce848 NC |
1012 | # QQQ => 14, |
1013 | # PPP => 13, | |
1014 | # OOO => 12, | |
1015 | # NNN => 11, | |
1016 | # MMM => 10, | |
1017 | # LLL => 9, | |
1018 | # KKK => 8, | |
1019 | # JJJ => 7, | |
1020 | # III => 6 | |
e9105f86 IN |
1021 | # } |
1022 | #]; | |
1023 | EOT | |
1024 | ||
5b50ddc0 TC |
1025 | TEST q(Data::Dumper->new([[$c, $d]])->Dump;), "more sortkeys sub"; |
1026 | # the XS code does number values as strings | |
1027 | $WANT =~ s/ (\d+)(,?)$/ '$1'$2/gm; | |
1028 | TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;), "more sortkeys sub (XS)" | |
e9105f86 IN |
1029 | if $XS; |
1030 | } | |
8e5f9a6e RGS |
1031 | |
1032 | { | |
1033 | local $Data::Dumper::Deparse = 1; | |
1034 | local $Data::Dumper::Indent = 2; | |
1035 | ||
1036 | ############# 211 | |
1037 | ## | |
1038 | $WANT = <<'EOT'; | |
1039 | #$VAR1 = { | |
1040 | # foo => sub { | |
41a63c2f MA |
1041 | # print 'foo'; |
1042 | # } | |
8e5f9a6e RGS |
1043 | # }; |
1044 | EOT | |
1045 | ||
4543415b MHM |
1046 | if(" $Config{'extensions'} " !~ m[ B ]) { |
1047 | SKIP_TEST "Perl configured without B module"; | |
1048 | } else { | |
c7780833 JK |
1049 | TEST (q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump), |
1050 | 'Deparse 1: Indent 2; Dump()'); | |
4543415b | 1051 | } |
8e5f9a6e | 1052 | } |
c4cce848 NC |
1053 | |
1054 | ############# 214 | |
1055 | ## | |
1056 | ||
1057 | # This is messy. | |
1058 | # The controls (bare numbers) are stored either as integers or floating point. | |
1059 | # [depending on whether the tokeniser sees things like ".". | |
1060 | # The peephole optimiser only runs for constant folding, not single constants, | |
1061 | # so I already have some NVs, some IVs | |
1062 | # The string versions are not. They are all PV | |
1063 | ||
1064 | # This is arguably all far too chummy with the implementation, but I really | |
1065 | # want to ensure that we don't go wrong when flags on scalars get as side | |
1066 | # effects of reading them. | |
1067 | ||
1068 | # These tests are actually testing the precise output of the current | |
1069 | # implementation, so will most likely fail if the implementation changes, | |
1070 | # even if the new implementation produces different but correct results. | |
1071 | # It would be nice to test for wrong answers, but I can't see how to do that, | |
1072 | # so instead I'm checking for unexpected answers. (ie -2 becoming "-2" is not | |
1073 | # wrong, but I can't see an easy, reliable way to code that knowledge) | |
1074 | ||
1075 | # Numbers (seen by the tokeniser as numbers, stored as numbers. | |
1076 | @numbers = | |
1077 | ( | |
1078 | 0, +1, -2, 3.0, +4.0, -5.0, 6.5, +7.5, -8.5, | |
1079 | 9, +10, -11, 12.0, +13.0, -14.0, 15.5, +16.25, -17.75, | |
1080 | ); | |
1081 | # Strings | |
1082 | @strings = | |
1083 | ( | |
1084 | "0", "+1", "-2", "3.0", "+4.0", "-5.0", "6.5", "+7.5", "-8.5", " 9", | |
1085 | " +10", " -11", " 12.0", " +13.0", " -14.0", " 15.5", " +16.25", " -17.75", | |
1086 | ); | |
1087 | ||
1088 | # The perl code always does things the same way for numbers. | |
1089 | $WANT_PL_N = <<'EOT'; | |
1090 | #$VAR1 = 0; | |
1091 | #$VAR2 = 1; | |
1092 | #$VAR3 = -2; | |
1093 | #$VAR4 = 3; | |
1094 | #$VAR5 = 4; | |
1095 | #$VAR6 = -5; | |
1096 | #$VAR7 = '6.5'; | |
1097 | #$VAR8 = '7.5'; | |
1098 | #$VAR9 = '-8.5'; | |
1099 | #$VAR10 = 9; | |
1100 | #$VAR11 = 10; | |
1101 | #$VAR12 = -11; | |
1102 | #$VAR13 = 12; | |
1103 | #$VAR14 = 13; | |
1104 | #$VAR15 = -14; | |
1105 | #$VAR16 = '15.5'; | |
1106 | #$VAR17 = '16.25'; | |
1107 | #$VAR18 = '-17.75'; | |
1108 | EOT | |
1109 | # The perl code knows that 0 and -2 stringify exactly back to the strings, | |
1110 | # so it dumps them as numbers, not strings. | |
1111 | $WANT_PL_S = <<'EOT'; | |
1112 | #$VAR1 = 0; | |
1113 | #$VAR2 = '+1'; | |
1114 | #$VAR3 = -2; | |
1115 | #$VAR4 = '3.0'; | |
1116 | #$VAR5 = '+4.0'; | |
1117 | #$VAR6 = '-5.0'; | |
1118 | #$VAR7 = '6.5'; | |
1119 | #$VAR8 = '+7.5'; | |
1120 | #$VAR9 = '-8.5'; | |
1121 | #$VAR10 = ' 9'; | |
1122 | #$VAR11 = ' +10'; | |
1123 | #$VAR12 = ' -11'; | |
1124 | #$VAR13 = ' 12.0'; | |
1125 | #$VAR14 = ' +13.0'; | |
1126 | #$VAR15 = ' -14.0'; | |
1127 | #$VAR16 = ' 15.5'; | |
1128 | #$VAR17 = ' +16.25'; | |
1129 | #$VAR18 = ' -17.75'; | |
1130 | EOT | |
1131 | ||
1132 | # The XS code differs. | |
1133 | # These are the numbers as seen by the tokeniser. Constants aren't folded | |
1134 | # (which makes IVs where possible) so values the tokeniser thought were | |
1135 | # floating point are stored as NVs. The XS code outputs these as strings, | |
1136 | # but as it has converted them from NVs, leading + signs will not be there. | |
1137 | $WANT_XS_N = <<'EOT'; | |
1138 | #$VAR1 = 0; | |
1139 | #$VAR2 = 1; | |
1140 | #$VAR3 = -2; | |
1141 | #$VAR4 = '3'; | |
1142 | #$VAR5 = '4'; | |
1143 | #$VAR6 = '-5'; | |
1144 | #$VAR7 = '6.5'; | |
1145 | #$VAR8 = '7.5'; | |
1146 | #$VAR9 = '-8.5'; | |
1147 | #$VAR10 = 9; | |
1148 | #$VAR11 = 10; | |
1149 | #$VAR12 = -11; | |
1150 | #$VAR13 = '12'; | |
1151 | #$VAR14 = '13'; | |
1152 | #$VAR15 = '-14'; | |
1153 | #$VAR16 = '15.5'; | |
1154 | #$VAR17 = '16.25'; | |
1155 | #$VAR18 = '-17.75'; | |
1156 | EOT | |
1157 | ||
1158 | # These are the strings as seen by the tokeniser. The XS code will output | |
1159 | # these for all cases except where the scalar has been used in integer context | |
1160 | $WANT_XS_S = <<'EOT'; | |
1161 | #$VAR1 = '0'; | |
1162 | #$VAR2 = '+1'; | |
1163 | #$VAR3 = '-2'; | |
1164 | #$VAR4 = '3.0'; | |
1165 | #$VAR5 = '+4.0'; | |
1166 | #$VAR6 = '-5.0'; | |
1167 | #$VAR7 = '6.5'; | |
1168 | #$VAR8 = '+7.5'; | |
1169 | #$VAR9 = '-8.5'; | |
1170 | #$VAR10 = ' 9'; | |
1171 | #$VAR11 = ' +10'; | |
1172 | #$VAR12 = ' -11'; | |
1173 | #$VAR13 = ' 12.0'; | |
1174 | #$VAR14 = ' +13.0'; | |
1175 | #$VAR15 = ' -14.0'; | |
1176 | #$VAR16 = ' 15.5'; | |
1177 | #$VAR17 = ' +16.25'; | |
1178 | #$VAR18 = ' -17.75'; | |
1179 | EOT | |
1180 | ||
1181 | # These are the numbers as IV-ized by & | |
1182 | # These will differ from WANT_XS_N because now IV flags will be set on all | |
1183 | # values that were actually integer, and the XS code will then output these | |
1184 | # as numbers not strings. | |
1185 | $WANT_XS_I = <<'EOT'; | |
1186 | #$VAR1 = 0; | |
1187 | #$VAR2 = 1; | |
1188 | #$VAR3 = -2; | |
1189 | #$VAR4 = 3; | |
1190 | #$VAR5 = 4; | |
1191 | #$VAR6 = -5; | |
1192 | #$VAR7 = '6.5'; | |
1193 | #$VAR8 = '7.5'; | |
1194 | #$VAR9 = '-8.5'; | |
1195 | #$VAR10 = 9; | |
1196 | #$VAR11 = 10; | |
1197 | #$VAR12 = -11; | |
1198 | #$VAR13 = 12; | |
1199 | #$VAR14 = 13; | |
1200 | #$VAR15 = -14; | |
1201 | #$VAR16 = '15.5'; | |
1202 | #$VAR17 = '16.25'; | |
1203 | #$VAR18 = '-17.75'; | |
1204 | EOT | |
1205 | ||
1206 | # Some of these tests will be redundant. | |
1207 | @numbers_s = @numbers_i = @numbers_is = @numbers_n = @numbers_ns = @numbers_ni | |
1208 | = @numbers_nis = @numbers; | |
1209 | @strings_s = @strings_i = @strings_is = @strings_n = @strings_ns = @strings_ni | |
1210 | = @strings_nis = @strings; | |
1211 | # Use them in an integer context | |
1212 | foreach (@numbers_i, @numbers_ni, @numbers_nis, @numbers_is, | |
1213 | @strings_i, @strings_ni, @strings_nis, @strings_is) { | |
1214 | my $b = sprintf "%d", $_; | |
1215 | } | |
1216 | # Use them in a floating point context | |
1217 | foreach (@numbers_n, @numbers_ni, @numbers_nis, @numbers_ns, | |
1218 | @strings_n, @strings_ni, @strings_nis, @strings_ns) { | |
1219 | my $b = sprintf "%e", $_; | |
1220 | } | |
1221 | # Use them in a string context | |
1222 | foreach (@numbers_s, @numbers_is, @numbers_nis, @numbers_ns, | |
1223 | @strings_s, @strings_is, @strings_nis, @strings_ns) { | |
1224 | my $b = sprintf "%s", $_; | |
1225 | } | |
1226 | ||
1227 | # use Devel::Peek; Dump ($_) foreach @vanilla_c; | |
1228 | ||
1229 | $WANT=$WANT_PL_N; | |
1230 | TEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers'; | |
1231 | TEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV'; | |
1232 | TEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV'; | |
1233 | TEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV'; | |
1234 | TEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV'; | |
1235 | TEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV'; | |
1236 | TEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV'; | |
1237 | TEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV'; | |
1238 | $WANT=$WANT_PL_S; | |
1239 | TEST q(Data::Dumper->new(\@strings)->Dump), 'Strings'; | |
1240 | TEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV'; | |
1241 | TEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV'; | |
1242 | TEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV'; | |
1243 | TEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV'; | |
1244 | TEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV'; | |
1245 | TEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV'; | |
1246 | TEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV'; | |
1247 | if ($XS) { | |
78d00c47 | 1248 | my $nv_preserves_uv = defined $Config{d_nv_preserves_uv}; |
04fe7e43 | 1249 | my $nv_preserves_uv_4bits = exists($Config{nv_preserves_uv_bits}) && $Config{nv_preserves_uv_bits} >= 4; |
c4cce848 NC |
1250 | $WANT=$WANT_XS_N; |
1251 | TEST q(Data::Dumper->new(\@numbers)->Dumpxs), 'XS Numbers'; | |
1252 | TEST q(Data::Dumper->new(\@numbers_s)->Dumpxs), 'XS Numbers PV'; | |
78d00c47 | 1253 | if ($nv_preserves_uv || $nv_preserves_uv_4bits) { |
c4cce848 NC |
1254 | $WANT=$WANT_XS_I; |
1255 | TEST q(Data::Dumper->new(\@numbers_i)->Dumpxs), 'XS Numbers IV'; | |
1256 | TEST q(Data::Dumper->new(\@numbers_is)->Dumpxs), 'XS Numbers IV,PV'; | |
78d00c47 TS |
1257 | } else { |
1258 | SKIP_TEST "NV does not preserve 4bits"; | |
1259 | SKIP_TEST "NV does not preserve 4bits"; | |
1260 | } | |
c4cce848 NC |
1261 | $WANT=$WANT_XS_N; |
1262 | TEST q(Data::Dumper->new(\@numbers_n)->Dumpxs), 'XS Numbers NV'; | |
1263 | TEST q(Data::Dumper->new(\@numbers_ns)->Dumpxs), 'XS Numbers NV,PV'; | |
78d00c47 | 1264 | if ($nv_preserves_uv || $nv_preserves_uv_4bits) { |
c4cce848 NC |
1265 | $WANT=$WANT_XS_I; |
1266 | TEST q(Data::Dumper->new(\@numbers_ni)->Dumpxs), 'XS Numbers NV,IV'; | |
1267 | TEST q(Data::Dumper->new(\@numbers_nis)->Dumpxs), 'XS Numbers NV,IV,PV'; | |
78d00c47 TS |
1268 | } else { |
1269 | SKIP_TEST "NV does not preserve 4bits"; | |
1270 | SKIP_TEST "NV does not preserve 4bits"; | |
1271 | } | |
c4cce848 NC |
1272 | |
1273 | $WANT=$WANT_XS_S; | |
1274 | TEST q(Data::Dumper->new(\@strings)->Dumpxs), 'XS Strings'; | |
1275 | TEST q(Data::Dumper->new(\@strings_s)->Dumpxs), 'XS Strings PV'; | |
1276 | # This one used to really mess up. New code actually emulates the .pm code | |
1277 | $WANT=$WANT_PL_S; | |
1278 | TEST q(Data::Dumper->new(\@strings_i)->Dumpxs), 'XS Strings IV'; | |
1279 | TEST q(Data::Dumper->new(\@strings_is)->Dumpxs), 'XS Strings IV,PV'; | |
78d00c47 | 1280 | if ($nv_preserves_uv || $nv_preserves_uv_4bits) { |
c4cce848 NC |
1281 | $WANT=$WANT_XS_S; |
1282 | TEST q(Data::Dumper->new(\@strings_n)->Dumpxs), 'XS Strings NV'; | |
1283 | TEST q(Data::Dumper->new(\@strings_ns)->Dumpxs), 'XS Strings NV,PV'; | |
78d00c47 TS |
1284 | } else { |
1285 | SKIP_TEST "NV does not preserve 4bits"; | |
1286 | SKIP_TEST "NV does not preserve 4bits"; | |
1287 | } | |
c4cce848 NC |
1288 | # This one used to really mess up. New code actually emulates the .pm code |
1289 | $WANT=$WANT_PL_S; | |
1290 | TEST q(Data::Dumper->new(\@strings_ni)->Dumpxs), 'XS Strings NV,IV'; | |
1291 | TEST q(Data::Dumper->new(\@strings_nis)->Dumpxs), 'XS Strings NV,IV,PV'; | |
1292 | } | |
1293 | ||
1294 | { | |
1295 | $a = "1\n"; | |
1296 | ############# 310 | |
1297 | ## Perl code was using /...$/ and hence missing the \n. | |
1298 | $WANT = <<'EOT'; | |
1299 | my $VAR1 = '42 | |
1300 | '; | |
1301 | EOT | |
1302 | ||
1303 | # Can't pad with # as the output has an embedded newline. | |
1304 | local $Data::Dumper::Pad = "my "; | |
1305 | TEST q(Data::Dumper->Dump(["42\n"])), "number with trailing newline"; | |
1306 | TEST q(Data::Dumper->Dumpxs(["42\n"])), "XS number with trailing newline" | |
1307 | if $XS; | |
1308 | } | |
1309 | ||
c4cce848 NC |
1310 | { |
1311 | @a = ( | |
1312 | 999999999, | |
1313 | 1000000000, | |
1314 | 9999999999, | |
1315 | 10000000000, | |
1316 | -999999999, | |
1317 | -1000000000, | |
1318 | -9999999999, | |
1319 | -10000000000, | |
1320 | 4294967295, | |
1321 | 4294967296, | |
1322 | -2147483648, | |
1323 | -2147483649, | |
1324 | ); | |
1325 | ############# 316 | |
1326 | ## Perl code flips over at 10 digits. | |
1327 | $WANT = <<'EOT'; | |
1328 | #$VAR1 = 999999999; | |
1329 | #$VAR2 = '1000000000'; | |
1330 | #$VAR3 = '9999999999'; | |
1331 | #$VAR4 = '10000000000'; | |
1332 | #$VAR5 = -999999999; | |
1333 | #$VAR6 = '-1000000000'; | |
1334 | #$VAR7 = '-9999999999'; | |
1335 | #$VAR8 = '-10000000000'; | |
1336 | #$VAR9 = '4294967295'; | |
1337 | #$VAR10 = '4294967296'; | |
1338 | #$VAR11 = '-2147483648'; | |
1339 | #$VAR12 = '-2147483649'; | |
1340 | EOT | |
1341 | ||
1342 | TEST q(Data::Dumper->Dump(\@a)), "long integers"; | |
1343 | ||
1344 | if ($XS) { | |
1345 | ## XS code flips over at 11 characters ("-" is a char) or larger than int. | |
1346 | if (~0 == 0xFFFFFFFF) { | |
1347 | # 32 bit system | |
1348 | $WANT = <<'EOT'; | |
1349 | #$VAR1 = 999999999; | |
1350 | #$VAR2 = 1000000000; | |
1351 | #$VAR3 = '9999999999'; | |
1352 | #$VAR4 = '10000000000'; | |
1353 | #$VAR5 = -999999999; | |
1354 | #$VAR6 = '-1000000000'; | |
1355 | #$VAR7 = '-9999999999'; | |
1356 | #$VAR8 = '-10000000000'; | |
1357 | #$VAR9 = 4294967295; | |
1358 | #$VAR10 = '4294967296'; | |
1359 | #$VAR11 = '-2147483648'; | |
1360 | #$VAR12 = '-2147483649'; | |
1361 | EOT | |
1362 | } else { | |
1363 | $WANT = <<'EOT'; | |
1364 | #$VAR1 = 999999999; | |
1365 | #$VAR2 = 1000000000; | |
1366 | #$VAR3 = 9999999999; | |
1367 | #$VAR4 = '10000000000'; | |
1368 | #$VAR5 = -999999999; | |
1369 | #$VAR6 = '-1000000000'; | |
1370 | #$VAR7 = '-9999999999'; | |
1371 | #$VAR8 = '-10000000000'; | |
1372 | #$VAR9 = 4294967295; | |
1373 | #$VAR10 = 4294967296; | |
1374 | #$VAR11 = '-2147483648'; | |
1375 | #$VAR12 = '-2147483649'; | |
1376 | EOT | |
1377 | } | |
1378 | TEST q(Data::Dumper->Dumpxs(\@a)), "XS long integers"; | |
1379 | } | |
1380 | } | |
1381 | ||
f052740f NC |
1382 | #XXX} |
1383 | { | |
cf0d1c66 JH |
1384 | if ($Is_ebcdic) { |
1385 | $b = "Bad. XS didn't escape dollar sign"; | |
f052740f | 1386 | ############# 322 |
cf0d1c66 JH |
1387 | $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc |
1388 | #\$VAR1 = '\$b\"\@\\\\\xB1'; | |
1389 | EOT | |
1390 | $a = "\$b\"\@\\\xB1\x{100}"; | |
1391 | chop $a; | |
1392 | TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$"; | |
1393 | if ($XS) { | |
1394 | $WANT = <<'EOT'; # While this is "" string written inside "" here doc | |
1395 | #$VAR1 = "\$b\"\@\\\x{b1}"; | |
1396 | EOT | |
1397 | TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; | |
1398 | } | |
1399 | } else { | |
1400 | $b = "Bad. XS didn't escape dollar sign"; | |
1401 | ############# 322 | |
1402 | $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc | |
f052740f NC |
1403 | #\$VAR1 = '\$b\"\@\\\\\xA3'; |
1404 | EOT | |
1405 | ||
cf0d1c66 JH |
1406 | $a = "\$b\"\@\\\xA3\x{100}"; |
1407 | chop $a; | |
1408 | TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$"; | |
1409 | if ($XS) { | |
1410 | $WANT = <<'EOT'; # While this is "" string written inside "" here doc | |
f052740f NC |
1411 | #$VAR1 = "\$b\"\@\\\x{a3}"; |
1412 | EOT | |
cf0d1c66 JH |
1413 | TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; |
1414 | } | |
f052740f NC |
1415 | } |
1416 | # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")] | |
1417 | ############# 328 | |
1418 | $WANT = <<'EOT'; | |
1419 | #$VAR1 = '$b"'; | |
1420 | EOT | |
1421 | ||
1422 | $a = "\$b\"\x{100}"; | |
1423 | chop $a; | |
1424 | TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$"; | |
1425 | if ($XS) { | |
1426 | TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; | |
1427 | } | |
1428 | ||
1429 | ||
1430 | # XS used to produce 'D'oh!' which is well, D'oh! | |
1431 | # Andreas found this one, which in turn discovered the previous two. | |
1432 | ############# 334 | |
1433 | $WANT = <<'EOT'; | |
1434 | #$VAR1 = 'D\'oh!'; | |
1435 | EOT | |
1436 | ||
1437 | $a = "D'oh!\x{100}"; | |
1438 | chop $a; | |
1439 | TEST q(Data::Dumper->Dump([$a])), "utf8 flag with '"; | |
1440 | if ($XS) { | |
1441 | TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '"; | |
1442 | } | |
1443 | } | |
d075f8ed NC |
1444 | |
1445 | # Jarkko found that -Mutf8 caused some tests to fail. Turns out that there | |
1446 | # was an otherwise untested code path in the XS for utf8 hash keys with purity | |
1447 | # 1 | |
1448 | ||
1449 | { | |
1450 | $WANT = <<'EOT'; | |
1451 | #$ping = \*::ping; | |
1452 | #*::ping = \5; | |
1453 | #*::ping = { | |
1454 | # "\x{decaf}\x{decaf}\x{decaf}\x{decaf}" => do{my $o} | |
1455 | #}; | |
1456 | #*::ping{HASH}->{"\x{decaf}\x{decaf}\x{decaf}\x{decaf}"} = *::ping{SCALAR}; | |
1457 | #%pong = %{*::ping{HASH}}; | |
1458 | EOT | |
1459 | local $Data::Dumper::Purity = 1; | |
1460 | local $Data::Dumper::Sortkeys; | |
1461 | $ping = 5; | |
1462 | %ping = (chr (0xDECAF) x 4 =>\$ping); | |
1463 | for $Data::Dumper::Sortkeys (0, 1) { | |
fec5e1eb | 1464 | if($] >= 5.007) { |
c7780833 JK |
1465 | TEST (q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])), |
1466 | "utf8: Purity 1: Sortkeys: Dump()"); | |
1467 | TEST (q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])), | |
1468 | "utf8: Purity 1: Sortkeys: Dumpxs()") | |
1469 | if $XS; | |
fec5e1eb IM |
1470 | } else { |
1471 | SKIP_TEST "Incomplete support for UTF-8 in old perls"; | |
1472 | SKIP_TEST "Incomplete support for UTF-8 in old perls"; | |
1473 | } | |
d075f8ed NC |
1474 | } |
1475 | } | |
fdce9ba9 NC |
1476 | |
1477 | # XS for quotekeys==0 was not being defensive enough against utf8 flagged | |
1478 | # scalars | |
1479 | ||
1480 | { | |
1481 | $WANT = <<'EOT'; | |
1482 | #$VAR1 = { | |
1483 | # perl => 'rocks' | |
1484 | #}; | |
1485 | EOT | |
1486 | local $Data::Dumper::Quotekeys = 0; | |
1487 | my $k = 'perl' . chr 256; | |
1488 | chop $k; | |
1489 | %foo = ($k => 'rocks'); | |
1490 | ||
1491 | TEST q(Data::Dumper->Dump([\\%foo])), "quotekeys == 0 for utf8 flagged ASCII"; | |
1492 | TEST q(Data::Dumper->Dumpxs([\\%foo])), | |
1493 | "XS quotekeys == 0 for utf8 flagged ASCII" if $XS; | |
1494 | } | |
3bef8b4a RGS |
1495 | ############# 358 |
1496 | { | |
1497 | $WANT = <<'EOT'; | |
1498 | #$VAR1 = [ | |
1499 | # undef, | |
1500 | # undef, | |
1501 | # 1 | |
1502 | #]; | |
1503 | EOT | |
1504 | @foo = (); | |
1505 | $foo[2] = 1; | |
c7780833 JK |
1506 | TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>: Dump()'; |
1507 | TEST q(Data::Dumper->Dumpxs([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>: Dumpxs()'if $XS; | |
3bef8b4a RGS |
1508 | } |
1509 | ||
fe642606 FC |
1510 | ############# 364 |
1511 | # Make sure $obj->Dumpxs returns the right thing in list context. This was | |
1512 | # broken by the initial attempt to fix [perl #74170]. | |
1513 | $WANT = <<'EOT'; | |
1514 | #$VAR1 = []; | |
1515 | EOT | |
1516 | TEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs), | |
1517 | '$obj->Dumpxs in list context' | |
1518 | if $XS; | |
3bef8b4a | 1519 | |
45e462ce SR |
1520 | ############# 366 |
1521 | { | |
1522 | $WANT = <<'EOT'; | |
1523 | #$VAR1 = [ | |
1524 | # "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377" | |
1525 | #]; | |
1526 | EOT | |
1527 | ||
1528 | $foo = [ join "", map chr, 0..255 ]; | |
1529 | local $Data::Dumper::Useqq = 1; | |
c7780833 JK |
1530 | TEST (q(Dumper($foo)), 'All latin1 characters: Dumper'); |
1531 | TEST (q(Data::Dumper::DumperX($foo)), 'All latin1 characters: DumperX') if $XS; | |
45e462ce SR |
1532 | } |
1533 | ||
1534 | ############# 372 | |
1535 | { | |
1536 | $WANT = <<'EOT'; | |
1537 | #$VAR1 = [ | |
1538 | # "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\x{80}\x{81}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8d}\x{8e}\x{8f}\x{90}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9d}\x{9e}\x{9f}\x{a0}\x{a1}\x{a2}\x{a3}\x{a4}\x{a5}\x{a6}\x{a7}\x{a8}\x{a9}\x{aa}\x{ab}\x{ac}\x{ad}\x{ae}\x{af}\x{b0}\x{b1}\x{b2}\x{b3}\x{b4}\x{b5}\x{b6}\x{b7}\x{b8}\x{b9}\x{ba}\x{bb}\x{bc}\x{bd}\x{be}\x{bf}\x{c0}\x{c1}\x{c2}\x{c3}\x{c4}\x{c5}\x{c6}\x{c7}\x{c8}\x{c9}\x{ca}\x{cb}\x{cc}\x{cd}\x{ce}\x{cf}\x{d0}\x{d1}\x{d2}\x{d3}\x{d4}\x{d5}\x{d6}\x{d7}\x{d8}\x{d9}\x{da}\x{db}\x{dc}\x{dd}\x{de}\x{df}\x{e0}\x{e1}\x{e2}\x{e3}\x{e4}\x{e5}\x{e6}\x{e7}\x{e8}\x{e9}\x{ea}\x{eb}\x{ec}\x{ed}\x{ee}\x{ef}\x{f0}\x{f1}\x{f2}\x{f3}\x{f4}\x{f5}\x{f6}\x{f7}\x{f8}\x{f9}\x{fa}\x{fb}\x{fc}\x{fd}\x{fe}\x{ff}\x{20ac}" | |
1539 | #]; | |
1540 | EOT | |
1541 | ||
1542 | $foo = [ join "", map chr, 0..255, 0x20ac ]; | |
1543 | local $Data::Dumper::Useqq = 1; | |
8ec7030c FC |
1544 | if ($] < 5.007) { |
1545 | print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3; | |
1546 | } | |
1547 | else { | |
1548 | TEST q(Dumper($foo)), | |
c7780833 | 1549 | 'All latin1 characters with utf8 flag including a wide character: Dumper'; |
8ec7030c | 1550 | } |
c7780833 JK |
1551 | TEST (q(Data::Dumper::DumperX($foo)), |
1552 | 'All latin1 characters with utf8 flag including a wide character: DumperX') | |
1553 | if $XS; | |
45e462ce | 1554 | } |
d036e907 FC |
1555 | |
1556 | ############# 378 | |
1557 | { | |
1558 | # If XS cannot load, the pure-Perl version cannot deparse vstrings with | |
1559 | # underscores properly. In 5.8.0, vstrings are just strings. | |
55d1a9a4 | 1560 | my $no_vstrings = <<'NOVSTRINGS'; |
d036e907 FC |
1561 | #$a = \'ABC'; |
1562 | #$b = \'ABC'; | |
1563 | #$c = \'ABC'; | |
1564 | #$d = \'ABC'; | |
55d1a9a4 S |
1565 | NOVSTRINGS |
1566 | my $vstrings_corr = <<'VSTRINGS_CORRECT'; | |
1567 | #$a = \v65.66.67; | |
1568 | #$b = \v65.66.067; | |
1569 | #$c = \v65.66.6_7; | |
1570 | #$d = \'ABC'; | |
1571 | VSTRINGS_CORRECT | |
1572 | $WANT = $] <= 5.0080001 | |
1573 | ? $no_vstrings | |
1574 | : $vstrings_corr; | |
1575 | ||
6c512c3f FC |
1576 | @::_v = ( |
1577 | \v65.66.67, | |
1578 | \($] < 5.007 ? v65.66.67 : eval 'v65.66.067'), | |
1579 | \v65.66.6_7, | |
1580 | \~v190.189.188 | |
1581 | ); | |
0ba3239a S |
1582 | if ($] >= 5.010) { |
1583 | TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings'; | |
1584 | TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings' | |
1585 | if $XS; | |
1586 | } | |
1587 | else { # Skip tests before 5.10. vstrings considered funny before | |
1588 | SKIP_TEST "vstrings considered funny before 5.10.0"; | |
1589 | SKIP_TEST "vstrings considered funny before 5.10.0 (XS)" | |
1590 | if $XS; | |
1591 | } | |
d036e907 | 1592 | } |
c1205a1e FC |
1593 | |
1594 | ############# 384 | |
1595 | { | |
1596 | # [perl #107372] blessed overloaded globs | |
1597 | $WANT = <<'EOW'; | |
1598 | #$VAR1 = bless( \*::finkle, 'overtest' ); | |
1599 | EOW | |
1600 | { | |
1601 | package overtest; | |
1602 | use overload fallback=>1, q\""\=>sub{"oaoaa"}; | |
1603 | } | |
1604 | TEST q(Data::Dumper->Dump([bless \*finkle, "overtest"])), | |
1605 | 'blessed overloaded globs'; | |
1606 | TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)' | |
1607 | if $XS; | |
1608 | } | |
dbf00f69 TC |
1609 | ############# 390 |
1610 | { | |
1611 | # [perl #74798] uncovered behaviour | |
1612 | $WANT = <<'EOW'; | |
1613 | #$VAR1 = "\0000"; | |
1614 | EOW | |
1615 | local $Data::Dumper::Useqq = 1; | |
1616 | TEST q(Data::Dumper->Dump(["\x000"])), | |
1617 | "\\ octal followed by digit"; | |
1618 | TEST q(Data::Dumper->Dumpxs(["\x000"])), '\\ octal followed by digit (xs)' | |
1619 | if $XS; | |
1620 | ||
1621 | $WANT = <<'EOW'; | |
1622 | #$VAR1 = "\x{100}\0000"; | |
1623 | EOW | |
1624 | local $Data::Dumper::Useqq = 1; | |
1625 | TEST q(Data::Dumper->Dump(["\x{100}\x000"])), | |
1626 | "\\ octal followed by digit unicode"; | |
1627 | TEST q(Data::Dumper->Dumpxs(["\x{100}\x000"])), '\\ octal followed by digit unicode (xs)' | |
1628 | if $XS; | |
1629 | ||
1630 | ||
1631 | $WANT = <<'EOW'; | |
1632 | #$VAR1 = "\0\x{660}"; | |
1633 | EOW | |
1634 | TEST q(Data::Dumper->Dump(["\\x00\\x{0660}"])), | |
1635 | "\\ octal followed by unicode digit"; | |
1636 | TEST q(Data::Dumper->Dumpxs(["\\x00\\x{0660}"])), '\\ octal followed by unicode digit (xs)' | |
1637 | if $XS; | |
059639d5 TC |
1638 | |
1639 | # [perl #118933 - handling of digits | |
1640 | $WANT = <<'EOW'; | |
1641 | #$VAR1 = 0; | |
1642 | #$VAR2 = 1; | |
1643 | #$VAR3 = 90; | |
1644 | #$VAR4 = -10; | |
1645 | #$VAR5 = "010"; | |
1646 | #$VAR6 = 112345678; | |
1647 | #$VAR7 = "1234567890"; | |
1648 | EOW | |
1649 | TEST q(Data::Dumper->Dump([0, 1, 90, -10, "010", "112345678", "1234567890" ])), | |
1650 | "numbers and number-like scalars"; | |
1651 | ||
1652 | TEST q(Data::Dumper->Dumpxs([0, 1, 90, -10, "010", "112345678", "1234567890" ])), | |
1653 | "numbers and number-like scalars" | |
1654 | if $XS; | |
dbf00f69 | 1655 | } |
b183d514 TC |
1656 | ############# 426 |
1657 | { | |
1658 | # [perl #82948] | |
1659 | # re::regexp_pattern was moved to universal.c in v5.10.0-252-g192c1e2 | |
1660 | # and apparently backported to maint-5.10 | |
1661 | $WANT = $] > 5.010 ? <<'NEW' : <<'OLD'; | |
1662 | #$VAR1 = qr/abc/; | |
1663 | #$VAR2 = qr/abc/i; | |
1664 | NEW | |
1665 | #$VAR1 = qr/(?-xism:abc)/; | |
1666 | #$VAR2 = qr/(?i-xsm:abc)/; | |
1667 | OLD | |
1668 | TEST q(Data::Dumper->Dump([ qr/abc/, qr/abc/i ])), "qr//"; | |
1669 | TEST q(Data::Dumper->Dumpxs([ qr/abc/, qr/abc/i ])), "qr// xs" | |
1670 | if $XS; | |
1671 | } | |
1672 | ############# 432 |