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