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