This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Data::Dumper/t/dumper.t: Remove test numbers from comments
[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
GS
18use Config;
19my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
823edd99
GS
20
21$Data::Dumper::Pad = "#";
22my $TMAX;
23my $XS;
24my $TNUM = 0;
25my $WANT = '';
26
27sub 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
73sub 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
84if (defined &Data::Dumper::Dumpxs) {
85 print "### XS extension loaded, will run XS tests\n";
4662a059 86 $TMAX = 438; $XS = 1;
823edd99
GS
87}
88else {
89 print "### XS extensions not loaded, will NOT run XS tests\n";
4662a059 90 $TMAX = 219; $XS = 0;
823edd99
GS
91}
92
93print "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
f0516858 107#############
823edd99
GS
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
123EOT
124
c7780833
JK
125TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])),
126 'basic test with names: Dump()');
127TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])),
128 'basic test with names: Dumpxs()')
129 if $XS;
823edd99 130
d424882c 131SCOPE: {
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
f0516858 141#############
823edd99
GS
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];
159EOT
160
161$Data::Dumper::Purity = 1; # fill in the holes for eval
c7780833
JK
162TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])),
163 'Purity: basic test with dereferenced array: Dump()'); # print as @a
164TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])),
165 'Purity: basic test with dereferenced array: Dumpxs()')
166 if $XS;
823edd99 167
d424882c
S
168SCOPE: {
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
f0516858 177#############
823edd99
GS
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'};
195EOT
196
c7780833
JK
197TEST (q(Data::Dumper->Dump([$b, $a], [qw(*b a)])),
198 'basic test with dereferenced hash: Dump()'); # print as %b
199TEST (q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])),
200 'basic test with dereferenced hash: Dumpxs()')
201 if $XS;
823edd99 202
f0516858 203#############
823edd99
GS
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];
220EOT
221
222$Data::Dumper::Indent = 1;
c7780833 223TEST (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 229if ($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
f0516858 239#############
823edd99
GS
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];
258EOT
259
260$d->Indent(3);
261$d->Purity(0)->Quotekeys(0);
c7780833
JK
262TEST (q( $d->Reset; $d->Dump ),
263 'Indent(3): Purity(0)->Quotekeys(0): Dump()');
823edd99 264
c7780833
JK
265TEST (q( $d->Reset; $d->Dumpxs ),
266 'Indent(3): Purity(0)->Quotekeys(0): Dumpxs()')
267 if $XS;
823edd99 268
f0516858 269#############
823edd99
GS
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'};
286EOT
287
c7780833
JK
288TEST (q(Dumper($a)), 'Dumper');
289TEST (q(Data::Dumper::DumperX($a)), 'DumperX') if $XS;
823edd99 290
f0516858 291#############
823edd99
GS
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#]
305EOT
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
f0516858 319#############
823edd99
GS
320##
321$WANT = <<'EOT';
322#$VAR1 = {
504f80c1
JH
323# "abc\0'\efg" => "mno\0",
324# "reftest" => \\1
823edd99
GS
325#};
326EOT
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
f0516858 351#############
823edd99
GS
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]};
376EOT
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 385
f0516858 386#############
823edd99
GS
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];
408EOT
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 416
f0516858 417#############
823edd99
GS
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];
439EOT
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 446
f0516858 447#############
823edd99
GS
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];
469EOT
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 476
f0516858 477#############
823edd99
GS
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]};
492EOT
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 501
f0516858 502#############
823edd99
GS
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];
517EOT
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
f0516858 540#############
823edd99
GS
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;
553EOT
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
f0516858 570#############
823edd99
GS
571##
572 $WANT = <<'EOT';
573#%kennels = %kennels;
574#@dogs = @dogs;
575#%mutts = %kennels;
576EOT
577
c7780833
JK
578 TEST q($d->Dump), 'object call: Dump';
579 TEST q($d->Dumpxs), 'object call: Dumpxs' if $XS;
3bd791fa 580
f0516858 581#############
823edd99
GS
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;
594EOT
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
f0516858 601#############
823edd99
GS
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]};
614EOT
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
f0516858 631#############
823edd99 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
f0516858 638#############
823edd99
GS
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#);
653EOT
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
673sub z { print "foo\n" }
674$c = [ \&z ];
823edd99 675
f0516858 676#############
823edd99
GS
677##
678 $WANT = <<'EOT';
679#$a = $b;
680#$c = [
681# $b
682#];
683EOT
684
c7780833
JK
685TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;),
686 'Seen: scalar: Dump');
687TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;),
688 'Seen: scalar: Dumpxs')
823edd99
GS
689 if $XS;
690
f0516858 691#############
823edd99
GS
692##
693 $WANT = <<'EOT';
694#$a = \&b;
695#$c = [
696# \&b
697#];
698EOT
699
c7780833
JK
700TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;),
701 'Seen: glob: Dump');
702TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;),
703 'Seen: glob: Dumpxs')
823edd99
GS
704 if $XS;
705
f0516858 706#############
823edd99
GS
707##
708 $WANT = <<'EOT';
709#*a = \&b;
710#@c = (
711# \&b
712#);
713EOT
714
c7780833
JK
715TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;),
716 'Seen: glob: dereference: Dump');
717TEST (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
f0516858 728#############
0f4592ef
GS
729##
730 $WANT = <<'EOT';
731#@a = (
732# undef,
5df59fb6 733# do{my $o}
0f4592ef
GS
734#);
735#$a[1] = \$a[0];
736EOT
737
c7780833
JK
738TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;),
739 'Purity(1): dereference: Dump');
740TEST (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
f0516858 749#############
0f4592ef
GS
750##
751 $WANT = <<'EOT';
752#$a = \\\\\'foo';
753#$b = ${${$a}};
754EOT
755
c7780833
JK
756TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;),
757 'Purity(1): not dereferenced: Dump');
758TEST (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
f0516858 767#############
0f4592ef
GS
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}};
788EOT
789
c7780833
JK
790TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;),
791 'Purity(1): Dump again');
792TEST (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
f0516858 802#############
0f4592ef
GS
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]}};
816EOT
817
c7780833
JK
818TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;),
819 'Purity(1): Dump: 3 elements');
820TEST (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
f0516858 833#############
a2126434
JN
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};
847EOT
848
c7780833
JK
849TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;),
850 'Maxdepth(4): Dump()');
851TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;),
852 'Maxdepth(4): Dumpxs()')
a2126434
JN
853 if $XS;
854
f0516858 855#############
a2126434
JN
856##
857 $WANT = <<'EOT';
858#$a = {
859# b => 'HASH(0xdeadbeef)'
860#};
861#$b = $a->{b};
862#$c = [
863# 'HASH(0xdeadbeef)'
864#];
865EOT
866
c7780833
JK
867TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;),
868 'Maxdepth(1): Dump()');
869TEST (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
f0516858 878#############
5df59fb6
GS
879##
880 $WANT = <<'EOT';
881#$b = [
882# \$b->[0]
883#];
884EOT
885
c7780833
JK
886TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;),
887 'Purity(0): Dump()');
888TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;),
889 'Purity(0): Dumpxs()')
5df59fb6
GS
890 if $XS;
891
f0516858 892#############
5df59fb6
GS
893##
894 $WANT = <<'EOT';
895#$b = [
896# \do{my $o}
897#];
898#${$b->[0]} = $b->[0];
899EOT
900
901
c7780833
JK
902TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;),
903 'Purity(1): Dump()');
904TEST (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}";
f0516858 911#############
f397e026
TC
912## XS code was adding an extra \0
913 $WANT = <<'EOT';
914#$a = "\x{9c10}";
915EOT
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 929
f0516858 930#############
e9105f86
IN
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#};
944EOT
945
c7780833
JK
946TEST (q(Data::Dumper->new([$a])->Dump;),
947 'basic test without names: Dump()');
948TEST (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
f0516858 962#############
e9105f86
IN
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#};
976EOT
977
5b50ddc0 978TEST q(Data::Dumper->new([$c])->Dump;), "sortkeys sub";
c7780833 979TEST 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
f0516858 996#############
e9105f86
IN
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#];
1023EOT
1024
5b50ddc0
TC
1025TEST 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;
1028TEST 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
f0516858 1036#############
8e5f9a6e
RGS
1037##
1038 $WANT = <<'EOT';
1039#$VAR1 = {
1040# foo => sub {
41a63c2f
MA
1041# print 'foo';
1042# }
8e5f9a6e
RGS
1043# };
1044EOT
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 1053
f0516858 1054#############
c4cce848
NC
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';
1108EOT
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';
1130EOT
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';
1156EOT
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';
1179EOT
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';
1204EOT
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
1212foreach (@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
1217foreach (@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
1222foreach (@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;
1230TEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers';
1231TEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV';
1232TEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV';
1233TEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV';
1234TEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV';
1235TEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV';
1236TEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV';
1237TEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV';
1238$WANT=$WANT_PL_S;
1239TEST q(Data::Dumper->new(\@strings)->Dump), 'Strings';
1240TEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV';
1241TEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV';
1242TEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV';
1243TEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV';
1244TEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV';
1245TEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV';
1246TEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV';
1247if ($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";
f0516858 1296#############
c4cce848
NC
1297## Perl code was using /...$/ and hence missing the \n.
1298 $WANT = <<'EOT';
1299my $VAR1 = '42
1300';
1301EOT
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 );
f0516858 1325#############
c4cce848
NC
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';
1340EOT
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';
1361EOT
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';
1376EOT
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
dd7a2a7a 1387 $WANT = <<"EOT"; # Careful. This is '' string written inside "" here doc
cf0d1c66
JH
1388#\$VAR1 = '\$b\"\@\\\\\xB1';
1389EOT
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}";
1396EOT
1397 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1398 }
1399 } else {
1400 $b = "Bad. XS didn't escape dollar sign";
f0516858 1401#############
dd7a2a7a 1402 $WANT = <<"EOT"; # Careful. This is '' string written inside "" here doc
f052740f
NC
1403#\$VAR1 = '\$b\"\@\\\\\xA3';
1404EOT
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}";
1412EOT
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\\\")]
f0516858 1417#############
f052740f
NC
1418 $WANT = <<'EOT';
1419#$VAR1 = '$b"';
1420EOT
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.
f0516858 1432#############
f052740f
NC
1433 $WANT = <<'EOT';
1434#$VAR1 = 'D\'oh!';
1435EOT
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}};
1458EOT
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#};
1485EOT
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}
f0516858 1495#############
3bef8b4a
RGS
1496{
1497 $WANT = <<'EOT';
1498#$VAR1 = [
1499# undef,
1500# undef,
1501# 1
1502#];
1503EOT
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
f0516858 1510#############
fe642606
FC
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 = [];
1515EOT
1516TEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs),
1517 '$obj->Dumpxs in list context'
1518 if $XS;
3bef8b4a 1519
f0516858 1520#############
45e462ce
SR
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#];
1526EOT
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
f0516858 1534#############
45e462ce
SR
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#];
1540EOT
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 1555
f0516858 1556#############
d036e907
FC
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
1565NOVSTRINGS
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';
1571VSTRINGS_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 1593
f0516858 1594#############
c1205a1e
FC
1595{
1596 # [perl #107372] blessed overloaded globs
1597 $WANT = <<'EOW';
1598#$VAR1 = bless( \*::finkle, 'overtest' );
1599EOW
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}
f0516858 1609#############
dbf00f69
TC
1610{
1611 # [perl #74798] uncovered behaviour
1612 $WANT = <<'EOW';
1613#$VAR1 = "\0000";
1614EOW
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";
1623EOW
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}";
1633EOW
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";
1648EOW
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}
f0516858 1656#############
b183d514
TC
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;
1664NEW
1665#$VAR1 = qr/(?-xism:abc)/;
1666#$VAR2 = qr/(?i-xsm:abc)/;
1667OLD
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}
f0516858 1672#############
4662a059
TC
1673
1674{
1675 sub foo {}
1676 $WANT = <<'EOW';
1677#*a = sub { "DUMMY" };
1678#$b = \&a;
1679EOW
1680
1681 TEST q(Data::Dumper->new([ \&foo, \\&foo ], [ "*a", "b" ])->Dump), "name of code in *foo";
4662a059
TC
1682 TEST q(Data::Dumper->new([ \&foo, \\&foo ], [ "*a", "b" ])->Dumpxs), "name of code in *foo xs"
1683 if $XS;
1684}
f0516858 1685#############