projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Integrate mainline
[p5sagit/p5-mst-13.2.git] / ext / Data / Dumper / t / dumper.t
CommitLineData
823edd99 1#!./perl -w
2#
3# testsuite for Data::Dumper
4#
5
6BEGIN {
7 chdir 't' if -d 't';
20822f61 8 @INC = '../lib';
be3174d2 9 require Config; import Config;
10 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
11 print "1..0 # Skip: Data::Dumper was not built\n";
12 exit 0;
13 }
823edd99 14}
15
16use Data::Dumper;
f70c35af 17use Config;
18my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
823edd99 19
20$Data::Dumper::Pad = "#";
21my $TMAX;
22my $XS;
23my $TNUM = 0;
24my $WANT = '';
25
26sub TEST {
27 my $string = shift;
c4cce848 28 my $name = shift;
823edd99 29 my $t = eval $string;
30 ++$TNUM;
a2126434 31 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
32 if ($WANT =~ /deadbeef/);
f70c35af 33 if ($Is_ebcdic) {
34 # these data need massaging with non ascii character sets
35 # because of hashing order differences
36 $WANT = join("\n",sort(split(/\n/,$WANT)));
37 $WANT =~ s/\,$//mg;
38 $t = join("\n",sort(split(/\n/,$t)));
39 $t =~ s/\,$//mg;
40 }
c4cce848 41 $name = $name ? " - $name" : '';
42 print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n"
43 : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
823edd99 44
45 ++$TNUM;
46 eval "$t";
47 print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
48
49 $t = eval $string;
50 ++$TNUM;
a2126434 51 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
52 if ($WANT =~ /deadbeef/);
f70c35af 53 if ($Is_ebcdic) {
54 # here too there are hashing order differences
55 $WANT = join("\n",sort(split(/\n/,$WANT)));
56 $WANT =~ s/\,$//mg;
57 $t = join("\n",sort(split(/\n/,$t)));
58 $t =~ s/\,$//mg;
59 }
823edd99 60 print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
61 : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
62}
63
c4cce848 64# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
65# it direct. Out here it lets us knobble the next if to test that the perl
66# only tests do work (and count correctly)
67$Data::Dumper::Useperl = 1;
823edd99 68if (defined &Data::Dumper::Dumpxs) {
69 print "### XS extension loaded, will run XS tests\n";
80a5d8e7 70 $TMAX = 339; $XS = 1;
823edd99 71}
72else {
73 print "### XS extensions not loaded, will NOT run XS tests\n";
80a5d8e7 74 $TMAX = 171; $XS = 0;
823edd99 75}
76
77print "1..$TMAX\n";
78
c4cce848 79#XXXif (0) {
823edd99 80#############
81#############
82
83@c = ('c');
84$c = \@c;
85$b = {};
86$a = [1, $b, $c];
87$b->{a} = $a;
88$b->{b} = $a->[1];
89$b->{c} = $a->[2];
90
91############# 1
92##
93$WANT = <<'EOT';
94#$a = [
95# 1,
96# {
823edd99 97# 'c' => [
98# 'c'
a6fe520e 99# ],
100# 'a' => $a,
101# 'b' => $a->[1]
823edd99 102# },
103# $a->[1]{'c'}
104# ];
105#$b = $a->[1];
106#$c = $a->[1]{'c'};
107EOT
108
109TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
110TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
111
112
113############# 7
114##
115$WANT = <<'EOT';
116#@a = (
117# 1,
118# {
823edd99 119# 'c' => [
120# 'c'
a6fe520e 121# ],
122# 'a' => [],
123# 'b' => {}
823edd99 124# },
125# []
126# );
127#$a[1]{'a'} = \@a;
128#$a[1]{'b'} = $a[1];
129#$a[2] = $a[1]{'c'};
130#$b = $a[1];
131EOT
132
133$Data::Dumper::Purity = 1; # fill in the holes for eval
134TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
135TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
136
137############# 13
138##
139$WANT = <<'EOT';
140#%b = (
a6fe520e 141# 'c' => [
142# 'c'
143# ],
823edd99 144# 'a' => [
145# 1,
146# {},
a6fe520e 147# []
823edd99 148# ],
a6fe520e 149# 'b' => {}
823edd99 150# );
151#$b{'a'}[1] = \%b;
a6fe520e 152#$b{'a'}[2] = $b{'c'};
823edd99 153#$b{'b'} = \%b;
823edd99 154#$a = $b{'a'};
155EOT
156
157TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
158TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
159
160############# 19
161##
162$WANT = <<'EOT';
163#$a = [
164# 1,
165# {
a6fe520e 166# 'c' => [],
823edd99 167# 'a' => [],
a6fe520e 168# 'b' => {}
823edd99 169# },
170# []
171#];
a6fe520e 172#$a->[1]{'c'} = \@c;
823edd99 173#$a->[1]{'a'} = $a;
174#$a->[1]{'b'} = $a->[1];
823edd99 175#$a->[2] = \@c;
176#$b = $a->[1];
177EOT
178
179$Data::Dumper::Indent = 1;
180TEST q(
181 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
182 $d->Seen({'*c' => $c});
183 $d->Dump;
184 );
185if ($XS) {
186 TEST q(
187 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
188 $d->Seen({'*c' => $c});
189 $d->Dumpxs;
190 );
191}
192
193
194############# 25
195##
196$WANT = <<'EOT';
197#$a = [
198# #0
199# 1,
200# #1
201# {
823edd99 202# c => [
203# #0
204# 'c'
a6fe520e 205# ],
206# a => $a,
207# b => $a->[1]
823edd99 208# },
209# #2
210# $a->[1]{c}
211# ];
212#$b = $a->[1];
213EOT
214
215$d->Indent(3);
216$d->Purity(0)->Quotekeys(0);
217TEST q( $d->Reset; $d->Dump );
218
219TEST q( $d->Reset; $d->Dumpxs ) if $XS;
220
221############# 31
222##
223$WANT = <<'EOT';
224#$VAR1 = [
225# 1,
226# {
823edd99 227# 'c' => [
228# 'c'
a6fe520e 229# ],
230# 'a' => [],
231# 'b' => {}
823edd99 232# },
233# []
234#];
235#$VAR1->[1]{'a'} = $VAR1;
236#$VAR1->[1]{'b'} = $VAR1->[1];
237#$VAR1->[2] = $VAR1->[1]{'c'};
238EOT
239
240TEST q(Dumper($a));
241TEST q(Data::Dumper::DumperX($a)) if $XS;
242
243############# 37
244##
245$WANT = <<'EOT';
246#[
247# 1,
248# {
823edd99 249# c => [
250# 'c'
a6fe520e 251# ],
252# a => $VAR1,
253# b => $VAR1->[1]
823edd99 254# },
255# $VAR1->[1]{c}
256#]
257EOT
258
259{
260 local $Data::Dumper::Purity = 0;
261 local $Data::Dumper::Quotekeys = 0;
262 local $Data::Dumper::Terse = 1;
263 TEST q(Dumper($a));
264 TEST q(Data::Dumper::DumperX($a)) if $XS;
265}
266
267
268############# 43
269##
270$WANT = <<'EOT';
271#$VAR1 = {
a6fe520e 272# "reftest" => \\1,
273# "abc\0'\efg" => "mno\0"
823edd99 274#};
275EOT
276
54964f74 277$foo = { "abc\000\'\efg" => "mno\000",
278 "reftest" => \\1,
279 };
823edd99 280{
281 local $Data::Dumper::Useqq = 1;
282 TEST q(Dumper($foo));
283}
284
285 $WANT = <<"EOT";
286#\$VAR1 = {
a6fe520e 287# 'reftest' => \\\\1,
288# 'abc\0\\'\efg' => 'mno\0'
823edd99 289#};
290EOT
291
292 {
293 local $Data::Dumper::Useqq = 1;
294 TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat
295 }
296
297
298
299#############
300#############
301
302{
303 package main;
304 use Data::Dumper;
305 $foo = 5;
f32b5c8a 306 @foo = (-10,\*foo);
823edd99 307 %foo = (a=>1,b=>\$foo,c=>\@foo);
308 $foo{d} = \%foo;
309 $foo[2] = \%foo;
310
311############# 49
312##
313 $WANT = <<'EOT';
314#$foo = \*::foo;
315#*::foo = \5;
316#*::foo = [
317# #0
f32b5c8a 318# -10,
823edd99 319# #1
5df59fb6 320# do{my $o},
823edd99 321# #2
322# {
a6fe520e 323# 'c' => [],
823edd99 324# 'a' => 1,
5df59fb6 325# 'b' => do{my $o},
823edd99 326# 'd' => {}
327# }
328# ];
329#*::foo{ARRAY}->[1] = $foo;
823edd99 330#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
a6fe520e 331#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
823edd99 332#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
333#*::foo = *::foo{ARRAY}->[2];
334#@bar = @{*::foo{ARRAY}};
335#%baz = %{*::foo{ARRAY}->[2]};
336EOT
337
338 $Data::Dumper::Purity = 1;
339 $Data::Dumper::Indent = 3;
340 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
341 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
342
343############# 55
344##
345 $WANT = <<'EOT';
346#$foo = \*::foo;
347#*::foo = \5;
348#*::foo = [
f32b5c8a 349# -10,
5df59fb6 350# do{my $o},
823edd99 351# {
a6fe520e 352# 'c' => [],
823edd99 353# 'a' => 1,
5df59fb6 354# 'b' => do{my $o},
823edd99 355# 'd' => {}
356# }
357#];
358#*::foo{ARRAY}->[1] = $foo;
823edd99 359#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
a6fe520e 360#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
823edd99 361#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
362#*::foo = *::foo{ARRAY}->[2];
363#$bar = *::foo{ARRAY};
364#$baz = *::foo{ARRAY}->[2];
365EOT
366
367 $Data::Dumper::Indent = 1;
368 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
369 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
370
371############# 61
372##
373 $WANT = <<'EOT';
374#@bar = (
f32b5c8a 375# -10,
823edd99 376# \*::foo,
377# {}
378#);
379#*::foo = \5;
380#*::foo = \@bar;
381#*::foo = {
a6fe520e 382# 'c' => [],
823edd99 383# 'a' => 1,
5df59fb6 384# 'b' => do{my $o},
823edd99 385# 'd' => {}
386#};
823edd99 387#*::foo{HASH}->{'c'} = \@bar;
a6fe520e 388#*::foo{HASH}->{'b'} = *::foo{SCALAR};
823edd99 389#*::foo{HASH}->{'d'} = *::foo{HASH};
390#$bar[2] = *::foo{HASH};
391#%baz = %{*::foo{HASH}};
392#$foo = $bar[1];
393EOT
394
395 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
396 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
397
398############# 67
399##
400 $WANT = <<'EOT';
401#$bar = [
f32b5c8a 402# -10,
823edd99 403# \*::foo,
404# {}
405#];
406#*::foo = \5;
407#*::foo = $bar;
408#*::foo = {
a6fe520e 409# 'c' => [],
823edd99 410# 'a' => 1,
5df59fb6 411# 'b' => do{my $o},
823edd99 412# 'd' => {}
413#};
823edd99 414#*::foo{HASH}->{'c'} = $bar;
a6fe520e 415#*::foo{HASH}->{'b'} = *::foo{SCALAR};
823edd99 416#*::foo{HASH}->{'d'} = *::foo{HASH};
417#$bar->[2] = *::foo{HASH};
418#$baz = *::foo{HASH};
419#$foo = $bar->[1];
420EOT
421
422 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
423 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
424
425############# 73
426##
427 $WANT = <<'EOT';
428#$foo = \*::foo;
429#@bar = (
f32b5c8a 430# -10,
823edd99 431# $foo,
432# {
a6fe520e 433# c => \@bar,
823edd99 434# a => 1,
435# b => \5,
823edd99 436# d => $bar[2]
437# }
438#);
439#%baz = %{$bar[2]};
440EOT
441
442 $Data::Dumper::Purity = 0;
443 $Data::Dumper::Quotekeys = 0;
444 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
445 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
446
447############# 79
448##
449 $WANT = <<'EOT';
450#$foo = \*::foo;
451#$bar = [
f32b5c8a 452# -10,
823edd99 453# $foo,
454# {
a6fe520e 455# c => $bar,
823edd99 456# a => 1,
457# b => \5,
823edd99 458# d => $bar->[2]
459# }
460#];
461#$baz = $bar->[2];
462EOT
463
464 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
465 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
466
467}
468
469#############
470#############
471{
472 package main;
473 @dogs = ( 'Fido', 'Wags' );
474 %kennel = (
475 First => \$dogs[0],
476 Second => \$dogs[1],
477 );
478 $dogs[2] = \%kennel;
479 $mutts = \%kennel;
480 $mutts = $mutts; # avoid warning
481
482############# 85
483##
484 $WANT = <<'EOT';
485#%kennels = (
a6fe520e 486# Second => \'Wags',
487# First => \'Fido'
823edd99 488#);
489#@dogs = (
0f4592ef 490# ${$kennels{First}},
491# ${$kennels{Second}},
823edd99 492# \%kennels
493#);
494#%mutts = %kennels;
495EOT
496
497 TEST q(
498 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
499 [qw(*kennels *dogs *mutts)] );
500 $d->Dump;
501 );
502 if ($XS) {
503 TEST q(
504 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
505 [qw(*kennels *dogs *mutts)] );
506 $d->Dumpxs;
507 );
508 }
509
510############# 91
511##
512 $WANT = <<'EOT';
513#%kennels = %kennels;
514#@dogs = @dogs;
515#%mutts = %kennels;
516EOT
517
518 TEST q($d->Dump);
519 TEST q($d->Dumpxs) if $XS;
520
521############# 97
522##
523 $WANT = <<'EOT';
524#%kennels = (
a6fe520e 525# Second => \'Wags',
526# First => \'Fido'
823edd99 527#);
528#@dogs = (
0f4592ef 529# ${$kennels{First}},
530# ${$kennels{Second}},
823edd99 531# \%kennels
532#);
533#%mutts = %kennels;
534EOT
535
536
537 TEST q($d->Reset; $d->Dump);
538 if ($XS) {
539 TEST q($d->Reset; $d->Dumpxs);
540 }
541
542############# 103
543##
544 $WANT = <<'EOT';
545#@dogs = (
546# 'Fido',
547# 'Wags',
548# {
a6fe520e 549# Second => \$dogs[1],
550# First => \$dogs[0]
823edd99 551# }
552#);
553#%kennels = %{$dogs[2]};
554#%mutts = %{$dogs[2]};
555EOT
556
557 TEST q(
558 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
559 [qw(*dogs *kennels *mutts)] );
560 $d->Dump;
561 );
562 if ($XS) {
563 TEST q(
564 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
565 [qw(*dogs *kennels *mutts)] );
566 $d->Dumpxs;
567 );
568 }
569
570############# 109
571##
572 TEST q($d->Reset->Dump);
573 if ($XS) {
574 TEST q($d->Reset->Dumpxs);
575 }
576
577############# 115
578##
579 $WANT = <<'EOT';
580#@dogs = (
581# 'Fido',
582# 'Wags',
583# {
a6fe520e 584# Second => \'Wags',
585# First => \'Fido'
823edd99 586# }
587#);
588#%kennels = (
a6fe520e 589# Second => \'Wags',
590# First => \'Fido'
823edd99 591#);
592EOT
593
594 TEST q(
595 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
596 $d->Deepcopy(1)->Dump;
597 );
598 if ($XS) {
599 TEST q($d->Reset->Dumpxs);
600 }
601
602}
603
604{
605
0f4592ef 606sub z { print "foo\n" }
607$c = [ \&z ];
823edd99 608
609############# 121
610##
611 $WANT = <<'EOT';
612#$a = $b;
613#$c = [
614# $b
615#];
616EOT
617
0f4592ef 618TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
619TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
823edd99 620 if $XS;
621
622############# 127
623##
624 $WANT = <<'EOT';
625#$a = \&b;
626#$c = [
627# \&b
628#];
629EOT
630
0f4592ef 631TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
632TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
823edd99 633 if $XS;
634
635############# 133
636##
637 $WANT = <<'EOT';
638#*a = \&b;
639#@c = (
640# \&b
641#);
642EOT
643
0f4592ef 644TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
645TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
823edd99 646 if $XS;
647
648}
0f4592ef 649
650{
651 $a = [];
652 $a->[1] = \$a->[0];
653
654############# 139
655##
656 $WANT = <<'EOT';
657#@a = (
658# undef,
5df59fb6 659# do{my $o}
0f4592ef 660#);
661#$a[1] = \$a[0];
662EOT
663
664TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
665TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
666 if $XS;
667}
668
669{
670 $a = \\\\\'foo';
671 $b = $$$a;
672
673############# 145
674##
675 $WANT = <<'EOT';
676#$a = \\\\\'foo';
677#$b = ${${$a}};
678EOT
679
680TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
681TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
682 if $XS;
683}
684
685{
686 $a = [{ a => \$b }, { b => undef }];
687 $b = [{ c => \$b }, { d => \$a }];
688
689############# 151
690##
691 $WANT = <<'EOT';
692#$a = [
693# {
694# a => \[
695# {
5df59fb6 696# c => do{my $o}
0f4592ef 697# },
698# {
699# d => \[]
700# }
701# ]
702# },
703# {
704# b => undef
705# }
706#];
707#${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
708#${${$a->[0]{a}}->[1]->{d}} = $a;
709#$b = ${$a->[0]{a}};
710EOT
711
712TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
713TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
714 if $XS;
715}
716
717{
718 $a = [[[[\\\\\'foo']]]];
719 $b = $a->[0][0];
720 $c = $${$b->[0][0]};
721
722############# 157
723##
724 $WANT = <<'EOT';
725#$a = [
726# [
727# [
728# [
729# \\\\\'foo'
730# ]
731# ]
732# ]
733#];
734#$b = $a->[0][0];
735#$c = ${${$a->[0][0][0][0]}};
736EOT
737
738TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
739TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
740 if $XS;
741}
a2126434 742
743{
744 $f = "pearl";
745 $e = [ $f ];
746 $d = { 'e' => $e };
747 $c = [ $d ];
748 $b = { 'c' => $c };
749 $a = { 'b' => $b };
750
751############# 163
752##
753 $WANT = <<'EOT';
754#$a = {
755# b => {
756# c => [
757# {
758# e => 'ARRAY(0xdeadbeef)'
759# }
760# ]
761# }
762#};
763#$b = $a->{b};
764#$c = $a->{b}{c};
765EOT
766
767TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
768TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
769 if $XS;
770
771############# 169
772##
773 $WANT = <<'EOT';
774#$a = {
775# b => 'HASH(0xdeadbeef)'
776#};
777#$b = $a->{b};
778#$c = [
779# 'HASH(0xdeadbeef)'
780#];
781EOT
782
783TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
784TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
785 if $XS;
786}
5df59fb6 787
788{
789 $a = \$a;
790 $b = [$a];
791
792############# 175
793##
794 $WANT = <<'EOT';
795#$b = [
796# \$b->[0]
797#];
798EOT
799
800TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
801TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
802 if $XS;
803
804############# 181
805##
806 $WANT = <<'EOT';
807#$b = [
808# \do{my $o}
809#];
810#${$b->[0]} = $b->[0];
811EOT
812
813
814TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
815TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
816 if $XS;
817}
f397e026 818
819{
820 $a = "\x{09c10}";
821############# 187
822## XS code was adding an extra \0
823 $WANT = <<'EOT';
824#$a = "\x{9c10}";
825EOT
826
c4cce848 827 TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}";
828 TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}"
829 if $XS;
f397e026 830
831}
e9105f86 832
833{
834 $i = 0;
835 $a = { map { ("$_$_$_", ++$i) } 'I'..'Q' };
836 local $Data::Dumper::Sortkeys = 1;
837
838############# 193
839##
840 $WANT = <<'EOT';
841#$VAR1 = {
842# III => 1,
843# JJJ => 2,
844# KKK => 3,
845# LLL => 4,
846# MMM => 5,
847# NNN => 6,
848# OOO => 7,
849# PPP => 8,
850# QQQ => 9
851#};
852EOT
853
854TEST q(Data::Dumper->new([$a])->Dump;);
855TEST q(Data::Dumper->new([$a])->Dumpxs;)
856 if $XS;
857}
858
859{
860 $i = 5;
861 $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
862 local $Data::Dumper::Sortkeys = \&sort199;
863 sub sort199 {
864 my $hash = shift;
865 return [ sort { $b <=> $a } keys %$hash ];
866 }
867
868############# 199
869##
870 $WANT = <<'EOT';
871#$VAR1 = {
c4cce848 872# 14 => 'QQQ',
873# 13 => 'PPP',
874# 12 => 'OOO',
875# 11 => 'NNN',
876# 10 => 'MMM',
877# 9 => 'LLL',
878# 8 => 'KKK',
879# 7 => 'JJJ',
880# 6 => 'III'
e9105f86 881#};
882EOT
883
c4cce848 884# perl code does keys and values as numbers if possible
e9105f86 885TEST q(Data::Dumper->new([$c])->Dump;);
c4cce848 886# XS code always does them as strings
887$WANT =~ s/ (\d+)/ '$1'/gs;
e9105f86 888TEST q(Data::Dumper->new([$c])->Dumpxs;)
889 if $XS;
890}
891
892{
893 $i = 5;
894 $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
895 $d = { reverse %$c };
896 local $Data::Dumper::Sortkeys = \&sort205;
897 sub sort205 {
898 my $hash = shift;
899 return [
900 $hash eq $c ? (sort { $a <=> $b } keys %$hash)
901 : (reverse sort keys %$hash)
902 ];
903 }
904
905############# 205
906##
907 $WANT = <<'EOT';
908#$VAR1 = [
909# {
c4cce848 910# 6 => 'III',
911# 7 => 'JJJ',
912# 8 => 'KKK',
913# 9 => 'LLL',
914# 10 => 'MMM',
915# 11 => 'NNN',
916# 12 => 'OOO',
917# 13 => 'PPP',
918# 14 => 'QQQ'
e9105f86 919# },
920# {
c4cce848 921# QQQ => 14,
922# PPP => 13,
923# OOO => 12,
924# NNN => 11,
925# MMM => 10,
926# LLL => 9,
927# KKK => 8,
928# JJJ => 7,
929# III => 6
e9105f86 930# }
931#];
932EOT
933
934TEST q(Data::Dumper->new([[$c, $d]])->Dump;);
c4cce848 935$WANT =~ s/ (\d+)/ '$1'/gs;
e9105f86 936TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;)
937 if $XS;
938}
8e5f9a6e 939
940{
941 local $Data::Dumper::Deparse = 1;
942 local $Data::Dumper::Indent = 2;
943
944############# 211
945##
946 $WANT = <<'EOT';
947#$VAR1 = {
948# foo => sub {
949# print 'foo';
950# }
951# };
952EOT
953
954 TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump);
955}
c4cce848 956
957############# 214
958##
959
960# This is messy.
961# The controls (bare numbers) are stored either as integers or floating point.
962# [depending on whether the tokeniser sees things like ".".
963# The peephole optimiser only runs for constant folding, not single constants,
964# so I already have some NVs, some IVs
965# The string versions are not. They are all PV
966
967# This is arguably all far too chummy with the implementation, but I really
968# want to ensure that we don't go wrong when flags on scalars get as side
969# effects of reading them.
970
971# These tests are actually testing the precise output of the current
972# implementation, so will most likely fail if the implementation changes,
973# even if the new implementation produces different but correct results.
974# It would be nice to test for wrong answers, but I can't see how to do that,
975# so instead I'm checking for unexpected answers. (ie -2 becoming "-2" is not
976# wrong, but I can't see an easy, reliable way to code that knowledge)
977
978# Numbers (seen by the tokeniser as numbers, stored as numbers.
979 @numbers =
980 (
981 0, +1, -2, 3.0, +4.0, -5.0, 6.5, +7.5, -8.5,
982 9, +10, -11, 12.0, +13.0, -14.0, 15.5, +16.25, -17.75,
983 );
984# Strings
985 @strings =
986 (
987 "0", "+1", "-2", "3.0", "+4.0", "-5.0", "6.5", "+7.5", "-8.5", " 9",
988 " +10", " -11", " 12.0", " +13.0", " -14.0", " 15.5", " +16.25", " -17.75",
989 );
990
991# The perl code always does things the same way for numbers.
992 $WANT_PL_N = <<'EOT';
993#$VAR1 = 0;
994#$VAR2 = 1;
995#$VAR3 = -2;
996#$VAR4 = 3;
997#$VAR5 = 4;
998#$VAR6 = -5;
999#$VAR7 = '6.5';
1000#$VAR8 = '7.5';
1001#$VAR9 = '-8.5';
1002#$VAR10 = 9;
1003#$VAR11 = 10;
1004#$VAR12 = -11;
1005#$VAR13 = 12;
1006#$VAR14 = 13;
1007#$VAR15 = -14;
1008#$VAR16 = '15.5';
1009#$VAR17 = '16.25';
1010#$VAR18 = '-17.75';
1011EOT
1012# The perl code knows that 0 and -2 stringify exactly back to the strings,
1013# so it dumps them as numbers, not strings.
1014 $WANT_PL_S = <<'EOT';
1015#$VAR1 = 0;
1016#$VAR2 = '+1';
1017#$VAR3 = -2;
1018#$VAR4 = '3.0';
1019#$VAR5 = '+4.0';
1020#$VAR6 = '-5.0';
1021#$VAR7 = '6.5';
1022#$VAR8 = '+7.5';
1023#$VAR9 = '-8.5';
1024#$VAR10 = ' 9';
1025#$VAR11 = ' +10';
1026#$VAR12 = ' -11';
1027#$VAR13 = ' 12.0';
1028#$VAR14 = ' +13.0';
1029#$VAR15 = ' -14.0';
1030#$VAR16 = ' 15.5';
1031#$VAR17 = ' +16.25';
1032#$VAR18 = ' -17.75';
1033EOT
1034
1035# The XS code differs.
1036# These are the numbers as seen by the tokeniser. Constants aren't folded
1037# (which makes IVs where possible) so values the tokeniser thought were
1038# floating point are stored as NVs. The XS code outputs these as strings,
1039# but as it has converted them from NVs, leading + signs will not be there.
1040 $WANT_XS_N = <<'EOT';
1041#$VAR1 = 0;
1042#$VAR2 = 1;
1043#$VAR3 = -2;
1044#$VAR4 = '3';
1045#$VAR5 = '4';
1046#$VAR6 = '-5';
1047#$VAR7 = '6.5';
1048#$VAR8 = '7.5';
1049#$VAR9 = '-8.5';
1050#$VAR10 = 9;
1051#$VAR11 = 10;
1052#$VAR12 = -11;
1053#$VAR13 = '12';
1054#$VAR14 = '13';
1055#$VAR15 = '-14';
1056#$VAR16 = '15.5';
1057#$VAR17 = '16.25';
1058#$VAR18 = '-17.75';
1059EOT
1060
1061# These are the strings as seen by the tokeniser. The XS code will output
1062# these for all cases except where the scalar has been used in integer context
1063 $WANT_XS_S = <<'EOT';
1064#$VAR1 = '0';
1065#$VAR2 = '+1';
1066#$VAR3 = '-2';
1067#$VAR4 = '3.0';
1068#$VAR5 = '+4.0';
1069#$VAR6 = '-5.0';
1070#$VAR7 = '6.5';
1071#$VAR8 = '+7.5';
1072#$VAR9 = '-8.5';
1073#$VAR10 = ' 9';
1074#$VAR11 = ' +10';
1075#$VAR12 = ' -11';
1076#$VAR13 = ' 12.0';
1077#$VAR14 = ' +13.0';
1078#$VAR15 = ' -14.0';
1079#$VAR16 = ' 15.5';
1080#$VAR17 = ' +16.25';
1081#$VAR18 = ' -17.75';
1082EOT
1083
1084# These are the numbers as IV-ized by &
1085# These will differ from WANT_XS_N because now IV flags will be set on all
1086# values that were actually integer, and the XS code will then output these
1087# as numbers not strings.
1088 $WANT_XS_I = <<'EOT';
1089#$VAR1 = 0;
1090#$VAR2 = 1;
1091#$VAR3 = -2;
1092#$VAR4 = 3;
1093#$VAR5 = 4;
1094#$VAR6 = -5;
1095#$VAR7 = '6.5';
1096#$VAR8 = '7.5';
1097#$VAR9 = '-8.5';
1098#$VAR10 = 9;
1099#$VAR11 = 10;
1100#$VAR12 = -11;
1101#$VAR13 = 12;
1102#$VAR14 = 13;
1103#$VAR15 = -14;
1104#$VAR16 = '15.5';
1105#$VAR17 = '16.25';
1106#$VAR18 = '-17.75';
1107EOT
1108
1109# Some of these tests will be redundant.
1110@numbers_s = @numbers_i = @numbers_is = @numbers_n = @numbers_ns = @numbers_ni
1111 = @numbers_nis = @numbers;
1112@strings_s = @strings_i = @strings_is = @strings_n = @strings_ns = @strings_ni
1113 = @strings_nis = @strings;
1114# Use them in an integer context
1115foreach (@numbers_i, @numbers_ni, @numbers_nis, @numbers_is,
1116 @strings_i, @strings_ni, @strings_nis, @strings_is) {
1117 my $b = sprintf "%d", $_;
1118}
1119# Use them in a floating point context
1120foreach (@numbers_n, @numbers_ni, @numbers_nis, @numbers_ns,
1121 @strings_n, @strings_ni, @strings_nis, @strings_ns) {
1122 my $b = sprintf "%e", $_;
1123}
1124# Use them in a string context
1125foreach (@numbers_s, @numbers_is, @numbers_nis, @numbers_ns,
1126 @strings_s, @strings_is, @strings_nis, @strings_ns) {
1127 my $b = sprintf "%s", $_;
1128}
1129
1130# use Devel::Peek; Dump ($_) foreach @vanilla_c;
1131
1132$WANT=$WANT_PL_N;
1133TEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers';
1134TEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV';
1135TEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV';
1136TEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV';
1137TEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV';
1138TEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV';
1139TEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV';
1140TEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV';
1141$WANT=$WANT_PL_S;
1142TEST q(Data::Dumper->new(\@strings)->Dump), 'Strings';
1143TEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV';
1144TEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV';
1145TEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV';
1146TEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV';
1147TEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV';
1148TEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV';
1149TEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV';
1150if ($XS) {
1151 $WANT=$WANT_XS_N;
1152 TEST q(Data::Dumper->new(\@numbers)->Dumpxs), 'XS Numbers';
1153 TEST q(Data::Dumper->new(\@numbers_s)->Dumpxs), 'XS Numbers PV';
1154 $WANT=$WANT_XS_I;
1155 TEST q(Data::Dumper->new(\@numbers_i)->Dumpxs), 'XS Numbers IV';
1156 TEST q(Data::Dumper->new(\@numbers_is)->Dumpxs), 'XS Numbers IV,PV';
1157 $WANT=$WANT_XS_N;
1158 TEST q(Data::Dumper->new(\@numbers_n)->Dumpxs), 'XS Numbers NV';
1159 TEST q(Data::Dumper->new(\@numbers_ns)->Dumpxs), 'XS Numbers NV,PV';
1160 $WANT=$WANT_XS_I;
1161 TEST q(Data::Dumper->new(\@numbers_ni)->Dumpxs), 'XS Numbers NV,IV';
1162 TEST q(Data::Dumper->new(\@numbers_nis)->Dumpxs), 'XS Numbers NV,IV,PV';
1163
1164 $WANT=$WANT_XS_S;
1165 TEST q(Data::Dumper->new(\@strings)->Dumpxs), 'XS Strings';
1166 TEST q(Data::Dumper->new(\@strings_s)->Dumpxs), 'XS Strings PV';
1167 # This one used to really mess up. New code actually emulates the .pm code
1168 $WANT=$WANT_PL_S;
1169 TEST q(Data::Dumper->new(\@strings_i)->Dumpxs), 'XS Strings IV';
1170 TEST q(Data::Dumper->new(\@strings_is)->Dumpxs), 'XS Strings IV,PV';
1171 $WANT=$WANT_XS_S;
1172 TEST q(Data::Dumper->new(\@strings_n)->Dumpxs), 'XS Strings NV';
1173 TEST q(Data::Dumper->new(\@strings_ns)->Dumpxs), 'XS Strings NV,PV';
1174 # This one used to really mess up. New code actually emulates the .pm code
1175 $WANT=$WANT_PL_S;
1176 TEST q(Data::Dumper->new(\@strings_ni)->Dumpxs), 'XS Strings NV,IV';
1177 TEST q(Data::Dumper->new(\@strings_nis)->Dumpxs), 'XS Strings NV,IV,PV';
1178}
1179
1180{
1181 $a = "1\n";
1182############# 310
1183## Perl code was using /...$/ and hence missing the \n.
1184 $WANT = <<'EOT';
1185my $VAR1 = '42
1186';
1187EOT
1188
1189 # Can't pad with # as the output has an embedded newline.
1190 local $Data::Dumper::Pad = "my ";
1191 TEST q(Data::Dumper->Dump(["42\n"])), "number with trailing newline";
1192 TEST q(Data::Dumper->Dumpxs(["42\n"])), "XS number with trailing newline"
1193 if $XS;
1194}
1195
c4cce848 1196{
1197 @a = (
1198 999999999,
1199 1000000000,
1200 9999999999,
1201 10000000000,
1202 -999999999,
1203 -1000000000,
1204 -9999999999,
1205 -10000000000,
1206 4294967295,
1207 4294967296,
1208 -2147483648,
1209 -2147483649,
1210 );
1211############# 316
1212## Perl code flips over at 10 digits.
1213 $WANT = <<'EOT';
1214#$VAR1 = 999999999;
1215#$VAR2 = '1000000000';
1216#$VAR3 = '9999999999';
1217#$VAR4 = '10000000000';
1218#$VAR5 = -999999999;
1219#$VAR6 = '-1000000000';
1220#$VAR7 = '-9999999999';
1221#$VAR8 = '-10000000000';
1222#$VAR9 = '4294967295';
1223#$VAR10 = '4294967296';
1224#$VAR11 = '-2147483648';
1225#$VAR12 = '-2147483649';
1226EOT
1227
1228 TEST q(Data::Dumper->Dump(\@a)), "long integers";
1229
1230 if ($XS) {
1231## XS code flips over at 11 characters ("-" is a char) or larger than int.
1232 if (~0 == 0xFFFFFFFF) {
1233 # 32 bit system
1234 $WANT = <<'EOT';
1235#$VAR1 = 999999999;
1236#$VAR2 = 1000000000;
1237#$VAR3 = '9999999999';
1238#$VAR4 = '10000000000';
1239#$VAR5 = -999999999;
1240#$VAR6 = '-1000000000';
1241#$VAR7 = '-9999999999';
1242#$VAR8 = '-10000000000';
1243#$VAR9 = 4294967295;
1244#$VAR10 = '4294967296';
1245#$VAR11 = '-2147483648';
1246#$VAR12 = '-2147483649';
1247EOT
1248 } else {
1249 $WANT = <<'EOT';
1250#$VAR1 = 999999999;
1251#$VAR2 = 1000000000;
1252#$VAR3 = 9999999999;
1253#$VAR4 = '10000000000';
1254#$VAR5 = -999999999;
1255#$VAR6 = '-1000000000';
1256#$VAR7 = '-9999999999';
1257#$VAR8 = '-10000000000';
1258#$VAR9 = 4294967295;
1259#$VAR10 = 4294967296;
1260#$VAR11 = '-2147483648';
1261#$VAR12 = '-2147483649';
1262EOT
1263 }
1264 TEST q(Data::Dumper->Dumpxs(\@a)), "XS long integers";
1265 }
1266}
1267
80a5d8e7 1268#XXX}
1269{
1270 $b = "Bad. XS didn't escape dollar sign";
1271############# 322
1272 $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1273#\$VAR1 = '\$b\"\@\\\\\xA3';
1274EOT
1275
1276 $a = "\$b\"\@\\\xA3\x{100}";
1277 chop $a;
1278 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1279 if ($XS) {
1280 $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1281#$VAR1 = "\$b\"\@\\\x{a3}";
1282EOT
1283 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1284 }
1285 # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
1286############# 328
1287 $WANT = <<'EOT';
1288#$VAR1 = '$b"';
1289EOT
1290
1291 $a = "\$b\"\x{100}";
1292 chop $a;
1293 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1294 if ($XS) {
1295 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1296 }
1297
1298
1299 # XS used to produce 'D'oh!' which is well, D'oh!
1300 # Andreas found this one, which in turn discovered the previous two.
1301############# 334
1302 $WANT = <<'EOT';
1303#$VAR1 = 'D\'oh!';
1304EOT
1305
1306 $a = "D'oh!\x{100}";
1307 chop $a;
1308 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with '";
1309 if ($XS) {
1310 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '";
1311 }
1312}
Unnamed repository; edit this file to name it for gitweb.