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