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