This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump patchlevel; other minor fixes for clean build and test on
[perl5.git] / t / lib / dumper.t
1 #!./perl -w
2 #
3 # testsuite for Data::Dumper
4 #
5
6 BEGIN {
7     chdir 't' if -d 't';
8     @INC = '../lib' if -d '../lib';
9 }
10
11 use Data::Dumper;
12
13 $Data::Dumper::Pad = "#";
14 my $TMAX;
15 my $XS;
16 my $TNUM = 0;
17 my $WANT = '';
18
19 sub TEST {
20   my $string = shift;
21   my $t = eval $string;
22   ++$TNUM;
23   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
24         : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
25
26   ++$TNUM;
27   eval "$t";
28   print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
29
30   $t = eval $string;
31   ++$TNUM;
32   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
33         : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
34 }
35
36 if (defined &Data::Dumper::Dumpxs) {
37   print "### XS extension loaded, will run XS tests\n";
38   $TMAX = 162; $XS = 1;
39 }
40 else {
41   print "### XS extensions not loaded, will NOT run XS tests\n";
42   $TMAX = 86; $XS = 0;
43 }
44
45 print "1..$TMAX\n";
46
47 #############
48 #############
49
50 @c = ('c');
51 $c = \@c;
52 $b = {};
53 $a = [1, $b, $c];
54 $b->{a} = $a;
55 $b->{b} = $a->[1];
56 $b->{c} = $a->[2];
57
58 ############# 1
59 ##
60 $WANT = <<'EOT';
61 #$a = [
62 #       1,
63 #       {
64 #         'a' => $a,
65 #         'b' => $a->[1],
66 #         'c' => [
67 #                  'c'
68 #                ]
69 #       },
70 #       $a->[1]{'c'}
71 #     ];
72 #$b = $a->[1];
73 #$c = $a->[1]{'c'};
74 EOT
75
76 TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
77 TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
78
79
80 ############# 7
81 ##
82 $WANT = <<'EOT';
83 #@a = (
84 #       1,
85 #       {
86 #         'a' => [],
87 #         'b' => {},
88 #         'c' => [
89 #                  'c'
90 #                ]
91 #       },
92 #       []
93 #     );
94 #$a[1]{'a'} = \@a;
95 #$a[1]{'b'} = $a[1];
96 #$a[2] = $a[1]{'c'};
97 #$b = $a[1];
98 EOT
99
100 $Data::Dumper::Purity = 1;         # fill in the holes for eval
101 TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
102 TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
103
104 ############# 13
105 ##
106 $WANT = <<'EOT';
107 #%b = (
108 #       'a' => [
109 #                1,
110 #                {},
111 #                [
112 #                  'c'
113 #                ]
114 #              ],
115 #       'b' => {},
116 #       'c' => []
117 #     );
118 #$b{'a'}[1] = \%b;
119 #$b{'b'} = \%b;
120 #$b{'c'} = $b{'a'}[2];
121 #$a = $b{'a'};
122 EOT
123
124 TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
125 TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
126
127 ############# 19
128 ##
129 $WANT = <<'EOT';
130 #$a = [
131 #  1,
132 #  {
133 #    'a' => [],
134 #    'b' => {},
135 #    'c' => []
136 #  },
137 #  []
138 #];
139 #$a->[1]{'a'} = $a;
140 #$a->[1]{'b'} = $a->[1];
141 #$a->[1]{'c'} = \@c;
142 #$a->[2] = \@c;
143 #$b = $a->[1];
144 EOT
145
146 $Data::Dumper::Indent = 1;
147 TEST q(
148        $d = Data::Dumper->new([$a,$b], [qw(a b)]);
149        $d->Seen({'*c' => $c});
150        $d->Dump;
151       );
152 if ($XS) {
153   TEST q(
154          $d = Data::Dumper->new([$a,$b], [qw(a b)]);
155          $d->Seen({'*c' => $c});
156          $d->Dumpxs;
157         );
158 }
159
160
161 ############# 25
162 ##
163 $WANT = <<'EOT';
164 #$a = [
165 #       #0
166 #       1,
167 #       #1
168 #       {
169 #         a => $a,
170 #         b => $a->[1],
171 #         c => [
172 #                #0
173 #                'c'
174 #              ]
175 #       },
176 #       #2
177 #       $a->[1]{c}
178 #     ];
179 #$b = $a->[1];
180 EOT
181
182 $d->Indent(3);
183 $d->Purity(0)->Quotekeys(0);
184 TEST q( $d->Reset; $d->Dump );
185
186 TEST q( $d->Reset; $d->Dumpxs ) if $XS;
187
188 ############# 31
189 ##
190 $WANT = <<'EOT';
191 #$VAR1 = [
192 #  1,
193 #  {
194 #    'a' => [],
195 #    'b' => {},
196 #    'c' => [
197 #      'c'
198 #    ]
199 #  },
200 #  []
201 #];
202 #$VAR1->[1]{'a'} = $VAR1;
203 #$VAR1->[1]{'b'} = $VAR1->[1];
204 #$VAR1->[2] = $VAR1->[1]{'c'};
205 EOT
206
207 TEST q(Dumper($a));
208 TEST q(Data::Dumper::DumperX($a)) if $XS;
209
210 ############# 37
211 ##
212 $WANT = <<'EOT';
213 #[
214 #  1,
215 #  {
216 #    a => $VAR1,
217 #    b => $VAR1->[1],
218 #    c => [
219 #      'c'
220 #    ]
221 #  },
222 #  $VAR1->[1]{c}
223 #]
224 EOT
225
226 {
227   local $Data::Dumper::Purity = 0;
228   local $Data::Dumper::Quotekeys = 0;
229   local $Data::Dumper::Terse = 1;
230   TEST q(Dumper($a));
231   TEST q(Data::Dumper::DumperX($a)) if $XS;
232 }
233
234
235 ############# 43
236 ##
237 $WANT = <<'EOT';
238 #$VAR1 = {
239 #  "abc\0'\efg" => "mno\0"
240 #};
241 EOT
242
243 $foo = { "abc\000\'\efg" => "mno\000" };
244 {
245   local $Data::Dumper::Useqq = 1;
246   TEST q(Dumper($foo));
247 }
248
249   $WANT = <<"EOT";
250 #\$VAR1 = {
251 #  'abc\0\\'\efg' => 'mno\0'
252 #};
253 EOT
254
255   {
256     local $Data::Dumper::Useqq = 1;
257     TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
258   }
259
260
261
262 #############
263 #############
264
265 {
266   package main;
267   use Data::Dumper;
268   $foo = 5;
269   @foo = (10,\*foo);
270   %foo = (a=>1,b=>\$foo,c=>\@foo);
271   $foo{d} = \%foo;
272   $foo[2] = \%foo;
273
274 ############# 49
275 ##
276   $WANT = <<'EOT';
277 #$foo = \*::foo;
278 #*::foo = \5;
279 #*::foo = [
280 #           #0
281 #           10,
282 #           #1
283 #           '',
284 #           #2
285 #           {
286 #             'a' => 1,
287 #             'b' => '',
288 #             'c' => [],
289 #             'd' => {}
290 #           }
291 #         ];
292 #*::foo{ARRAY}->[1] = $foo;
293 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
294 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
295 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
296 #*::foo = *::foo{ARRAY}->[2];
297 #@bar = @{*::foo{ARRAY}};
298 #%baz = %{*::foo{ARRAY}->[2]};
299 EOT
300
301   $Data::Dumper::Purity = 1;
302   $Data::Dumper::Indent = 3;
303   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
304   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
305
306 ############# 55
307 ##
308   $WANT = <<'EOT';
309 #$foo = \*::foo;
310 #*::foo = \5;
311 #*::foo = [
312 #  10,
313 #  '',
314 #  {
315 #    'a' => 1,
316 #    'b' => '',
317 #    'c' => [],
318 #    'd' => {}
319 #  }
320 #];
321 #*::foo{ARRAY}->[1] = $foo;
322 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
323 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
324 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
325 #*::foo = *::foo{ARRAY}->[2];
326 #$bar = *::foo{ARRAY};
327 #$baz = *::foo{ARRAY}->[2];
328 EOT
329
330   $Data::Dumper::Indent = 1;
331   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
332   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
333
334 ############# 61
335 ##
336   $WANT = <<'EOT';
337 #@bar = (
338 #  10,
339 #  \*::foo,
340 #  {}
341 #);
342 #*::foo = \5;
343 #*::foo = \@bar;
344 #*::foo = {
345 #  'a' => 1,
346 #  'b' => '',
347 #  'c' => [],
348 #  'd' => {}
349 #};
350 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
351 #*::foo{HASH}->{'c'} = \@bar;
352 #*::foo{HASH}->{'d'} = *::foo{HASH};
353 #$bar[2] = *::foo{HASH};
354 #%baz = %{*::foo{HASH}};
355 #$foo = $bar[1];
356 EOT
357
358   TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
359   TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
360
361 ############# 67
362 ##
363   $WANT = <<'EOT';
364 #$bar = [
365 #  10,
366 #  \*::foo,
367 #  {}
368 #];
369 #*::foo = \5;
370 #*::foo = $bar;
371 #*::foo = {
372 #  'a' => 1,
373 #  'b' => '',
374 #  'c' => [],
375 #  'd' => {}
376 #};
377 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
378 #*::foo{HASH}->{'c'} = $bar;
379 #*::foo{HASH}->{'d'} = *::foo{HASH};
380 #$bar->[2] = *::foo{HASH};
381 #$baz = *::foo{HASH};
382 #$foo = $bar->[1];
383 EOT
384
385   TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
386   TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
387
388 ############# 73
389 ##
390   $WANT = <<'EOT';
391 #$foo = \*::foo;
392 #@bar = (
393 #  10,
394 #  $foo,
395 #  {
396 #    a => 1,
397 #    b => \5,
398 #    c => \@bar,
399 #    d => $bar[2]
400 #  }
401 #);
402 #%baz = %{$bar[2]};
403 EOT
404
405   $Data::Dumper::Purity = 0;
406   $Data::Dumper::Quotekeys = 0;
407   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
408   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
409
410 ############# 79
411 ##
412   $WANT = <<'EOT';
413 #$foo = \*::foo;
414 #$bar = [
415 #  10,
416 #  $foo,
417 #  {
418 #    a => 1,
419 #    b => \5,
420 #    c => $bar,
421 #    d => $bar->[2]
422 #  }
423 #];
424 #$baz = $bar->[2];
425 EOT
426
427   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
428   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
429
430 }
431
432 #############
433 #############
434 {
435   package main;
436   @dogs = ( 'Fido', 'Wags' );
437   %kennel = (
438             First => \$dogs[0],
439             Second =>  \$dogs[1],
440            );
441   $dogs[2] = \%kennel;
442   $mutts = \%kennel;
443   $mutts = $mutts;         # avoid warning
444   
445 ############# 85
446 ##
447   $WANT = <<'EOT';
448 #%kennels = (
449 #  First => \'Fido',
450 #  Second => \'Wags'
451 #);
452 #@dogs = (
453 #  ${$kennels{First}},
454 #  ${$kennels{Second}},
455 #  \%kennels
456 #);
457 #%mutts = %kennels;
458 EOT
459
460   TEST q(
461          $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
462                                 [qw(*kennels *dogs *mutts)] );
463          $d->Dump;
464         );
465   if ($XS) {
466     TEST q(
467            $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
468                                   [qw(*kennels *dogs *mutts)] );
469            $d->Dumpxs;
470           );
471   }
472   
473 ############# 91
474 ##
475   $WANT = <<'EOT';
476 #%kennels = %kennels;
477 #@dogs = @dogs;
478 #%mutts = %kennels;
479 EOT
480
481   TEST q($d->Dump);
482   TEST q($d->Dumpxs) if $XS;
483   
484 ############# 97
485 ##
486   $WANT = <<'EOT';
487 #%kennels = (
488 #  First => \'Fido',
489 #  Second => \'Wags'
490 #);
491 #@dogs = (
492 #  ${$kennels{First}},
493 #  ${$kennels{Second}},
494 #  \%kennels
495 #);
496 #%mutts = %kennels;
497 EOT
498
499   
500   TEST q($d->Reset; $d->Dump);
501   if ($XS) {
502     TEST q($d->Reset; $d->Dumpxs);
503   }
504
505 ############# 103
506 ##
507   $WANT = <<'EOT';
508 #@dogs = (
509 #  'Fido',
510 #  'Wags',
511 #  {
512 #    First => \$dogs[0],
513 #    Second => \$dogs[1]
514 #  }
515 #);
516 #%kennels = %{$dogs[2]};
517 #%mutts = %{$dogs[2]};
518 EOT
519
520   TEST q(
521          $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
522                                 [qw(*dogs *kennels *mutts)] );
523          $d->Dump;
524         );
525   if ($XS) {
526     TEST q(
527            $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
528                                   [qw(*dogs *kennels *mutts)] );
529            $d->Dumpxs;
530           );
531   }
532   
533 ############# 109
534 ##
535   TEST q($d->Reset->Dump);
536   if ($XS) {
537     TEST q($d->Reset->Dumpxs);
538   }
539
540 ############# 115
541 ##
542   $WANT = <<'EOT';
543 #@dogs = (
544 #  'Fido',
545 #  'Wags',
546 #  {
547 #    First => \'Fido',
548 #    Second => \'Wags'
549 #  }
550 #);
551 #%kennels = (
552 #  First => \'Fido',
553 #  Second => \'Wags'
554 #);
555 EOT
556
557   TEST q(
558          $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
559          $d->Deepcopy(1)->Dump;
560         );
561   if ($XS) {
562     TEST q($d->Reset->Dumpxs);
563   }
564   
565 }
566
567 {
568
569 sub z { print "foo\n" }
570 $c = [ \&z ];
571
572 ############# 121
573 ##
574   $WANT = <<'EOT';
575 #$a = $b;
576 #$c = [
577 #  $b
578 #];
579 EOT
580
581 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
582 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
583         if $XS;
584
585 ############# 127
586 ##
587   $WANT = <<'EOT';
588 #$a = \&b;
589 #$c = [
590 #  \&b
591 #];
592 EOT
593
594 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
595 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
596         if $XS;
597
598 ############# 133
599 ##
600   $WANT = <<'EOT';
601 #*a = \&b;
602 #@c = (
603 #  \&b
604 #);
605 EOT
606
607 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
608 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
609         if $XS;
610
611 }
612
613 {
614   $a = [];
615   $a->[1] = \$a->[0];
616
617 ############# 139
618 ##
619   $WANT = <<'EOT';
620 #@a = (
621 #  undef,
622 #  ''
623 #);
624 #$a[1] = \$a[0];
625 EOT
626
627 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
628 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
629         if $XS;
630 }
631
632 {
633   $a = \\\\\'foo';
634   $b = $$$a;
635
636 ############# 145
637 ##
638   $WANT = <<'EOT';
639 #$a = \\\\\'foo';
640 #$b = ${${$a}};
641 EOT
642
643 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
644 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
645         if $XS;
646 }
647
648 {
649   $a = [{ a => \$b }, { b => undef }];
650   $b = [{ c => \$b }, { d => \$a }];
651
652 ############# 151
653 ##
654   $WANT = <<'EOT';
655 #$a = [
656 #  {
657 #    a => \[
658 #        {
659 #          c => ''
660 #        },
661 #        {
662 #          d => \[]
663 #        }
664 #      ]
665 #  },
666 #  {
667 #    b => undef
668 #  }
669 #];
670 #${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
671 #${${$a->[0]{a}}->[1]->{d}} = $a;
672 #$b = ${$a->[0]{a}};
673 EOT
674
675 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
676 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
677         if $XS;
678 }
679
680 {
681   $a = [[[[\\\\\'foo']]]];
682   $b = $a->[0][0];
683   $c = $${$b->[0][0]};
684
685 ############# 157
686 ##
687   $WANT = <<'EOT';
688 #$a = [
689 #  [
690 #    [
691 #      [
692 #        \\\\\'foo'
693 #      ]
694 #    ]
695 #  ]
696 #];
697 #$b = $a->[0][0];
698 #$c = ${${$a->[0][0][0][0]}};
699 EOT
700
701 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
702 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
703         if $XS;
704 }