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