ext/Data/Dumper/t/dumper.t

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