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