ext/Data-Dumper/t/dumper.t

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