dist/Data-Dumper/t/dumper.t

   1 #!./perl -w
   2 #
   3 # testsuite for Data::Dumper
   4 #
   5
   6 BEGIN {
   7     require Config; import Config;
   8     if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
   9         print "1..0 # Skip: Data::Dumper was not built\n";
  10         exit 0;
  11     }
  12 }
  13
  14 # Since Perl 5.8.1 because otherwise hash ordering is really random.
  15 local $Data::Dumper::Sortkeys = 1;
  16
  17 use Data::Dumper;
  18 use Config;
  19 my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
  20
  21 $Data::Dumper::Pad = "#";
  22 my $TMAX;
  23 my $XS;
  24 my $TNUM = 0;
  25 my $WANT = '';
  26
  27 sub TEST {
  28   my $string = shift;
  29   my $name = shift;
  30   my $t = eval $string;
  31   ++$TNUM;
  32   $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
  33       if ($WANT =~ /deadbeef/);
  34   if ($Is_ebcdic) {
  35       # these data need massaging with non ascii character sets
  36       # because of hashing order differences
  37       $WANT = join("\n",sort(split(/\n/,$WANT)));
  38       $WANT =~ s/\,$//mg;
  39       $t    = join("\n",sort(split(/\n/,$t)));
  40       $t    =~ s/\,$//mg;
  41   }
  42   $name = $name ? " - $name" : '';
  43   print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n"
  44         : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
  45
  46   ++$TNUM;
  47   if ($Is_ebcdic) { # EBCDIC.
  48       if ($TNUM == 311 || $TNUM == 314) {
  49           eval $string;
  50       } else {
  51           eval $t;
  52       }
  53   } else {
  54       eval "$t";
  55   }
  56   print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\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 = 432; $XS = 1;
  87 }
  88 else {
  89   print "### XS extensions not loaded, will NOT run XS tests\n";
  90   $TMAX = 216; $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 SCOPE: {
 129   local $Data::Dumper::Sparseseen = 1;
 130   TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6]));
 131   TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS;
 132 }
 133
 134 ############# 7
 135 ##
 136 $WANT = <<'EOT';
 137 #@a = (
 138 #       1,
 139 #       {
 140 #         'a' => [],
 141 #         'b' => {},
 142 #         'c' => [
 143 #                  'c'
 144 #                ]
 145 #       },
 146 #       []
 147 #     );
 148 #$a[1]{'a'} = \@a;
 149 #$a[1]{'b'} = $a[1];
 150 #$a[2] = $a[1]{'c'};
 151 #$b = $a[1];
 152 EOT
 153
 154 $Data::Dumper::Purity = 1;         # fill in the holes for eval
 155 TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
 156 TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
 157
 158 SCOPE: {
 159   local $Data::Dumper::Sparseseen = 1;
 160   TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
 161   TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
 162 }
 163
 164 ############# 13
 165 ##
 166 $WANT = <<'EOT';
 167 #%b = (
 168 #       'a' => [
 169 #                1,
 170 #                {},
 171 #                [
 172 #                  'c'
 173 #                ]
 174 #              ],
 175 #       'b' => {},
 176 #       'c' => []
 177 #     );
 178 #$b{'a'}[1] = \%b;
 179 #$b{'b'} = \%b;
 180 #$b{'c'} = $b{'a'}[2];
 181 #$a = $b{'a'};
 182 EOT
 183
 184 TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
 185 TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
 186
 187 ############# 19
 188 ##
 189 $WANT = <<'EOT';
 190 #$a = [
 191 #  1,
 192 #  {
 193 #    'a' => [],
 194 #    'b' => {},
 195 #    'c' => []
 196 #  },
 197 #  []
 198 #];
 199 #$a->[1]{'a'} = $a;
 200 #$a->[1]{'b'} = $a->[1];
 201 #$a->[1]{'c'} = \@c;
 202 #$a->[2] = \@c;
 203 #$b = $a->[1];
 204 EOT
 205
 206 $Data::Dumper::Indent = 1;
 207 TEST q(
 208        $d = Data::Dumper->new([$a,$b], [qw(a b)]);
 209        $d->Seen({'*c' => $c});
 210        $d->Dump;
 211       );
 212 if ($XS) {
 213   TEST q(
 214          $d = Data::Dumper->new([$a,$b], [qw(a b)]);
 215          $d->Seen({'*c' => $c});
 216          $d->Dumpxs;
 217         );
 218 }
 219
 220
 221 ############# 25
 222 ##
 223 $WANT = <<'EOT';
 224 #$a = [
 225 #       #0
 226 #       1,
 227 #       #1
 228 #       {
 229 #         a => $a,
 230 #         b => $a->[1],
 231 #         c => [
 232 #                #0
 233 #                'c'
 234 #              ]
 235 #       },
 236 #       #2
 237 #       $a->[1]{c}
 238 #     ];
 239 #$b = $a->[1];
 240 EOT
 241
 242 $d->Indent(3);
 243 $d->Purity(0)->Quotekeys(0);
 244 TEST q( $d->Reset; $d->Dump );
 245
 246 TEST q( $d->Reset; $d->Dumpxs ) if $XS;
 247
 248 ############# 31
 249 ##
 250 $WANT = <<'EOT';
 251 #$VAR1 = [
 252 #  1,
 253 #  {
 254 #    'a' => [],
 255 #    'b' => {},
 256 #    'c' => [
 257 #      'c'
 258 #    ]
 259 #  },
 260 #  []
 261 #];
 262 #$VAR1->[1]{'a'} = $VAR1;
 263 #$VAR1->[1]{'b'} = $VAR1->[1];
 264 #$VAR1->[2] = $VAR1->[1]{'c'};
 265 EOT
 266
 267 TEST q(Dumper($a));
 268 TEST q(Data::Dumper::DumperX($a)) if $XS;
 269
 270 ############# 37
 271 ##
 272 $WANT = <<'EOT';
 273 #[
 274 #  1,
 275 #  {
 276 #    a => $VAR1,
 277 #    b => $VAR1->[1],
 278 #    c => [
 279 #      'c'
 280 #    ]
 281 #  },
 282 #  $VAR1->[1]{c}
 283 #]
 284 EOT
 285
 286 {
 287   local $Data::Dumper::Purity = 0;
 288   local $Data::Dumper::Quotekeys = 0;
 289   local $Data::Dumper::Terse = 1;
 290   TEST q(Dumper($a));
 291   TEST q(Data::Dumper::DumperX($a)) if $XS;
 292 }
 293
 294
 295 ############# 43
 296 ##
 297 $WANT = <<'EOT';
 298 #$VAR1 = {
 299 #  "abc\0'\efg" => "mno\0",
 300 #  "reftest" => \\1
 301 #};
 302 EOT
 303
 304 $foo = { "abc\000\'\efg" => "mno\000",
 305          "reftest" => \\1,
 306        };
 307 {
 308   local $Data::Dumper::Useqq = 1;
 309   TEST q(Dumper($foo));
 310   TEST q(Data::Dumper::DumperX($foo)) if $XS;
 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 TEST q(Data::Dumper->new([$c])->Dump;), "sortkeys sub";
 903 TEST q(Data::Dumper->new([$c])->Dumpxs;), "sort keys sub (XS)"
 904         if $XS;
 905 }
 906
 907 {
 908   $i = 5;
 909   $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
 910   $d = { reverse %$c };
 911   local $Data::Dumper::Sortkeys = \&sort205;
 912   sub sort205 {
 913     my $hash = shift;
 914     return [
 915       $hash eq $c ? (sort { $a <=> $b } keys %$hash)
 916                   : (reverse sort keys %$hash)
 917     ];
 918   }
 919
 920 ############# 205
 921 ##
 922   $WANT = <<'EOT';
 923 #$VAR1 = [
 924 #  {
 925 #    6 => 'III',
 926 #    7 => 'JJJ',
 927 #    8 => 'KKK',
 928 #    9 => 'LLL',
 929 #    10 => 'MMM',
 930 #    11 => 'NNN',
 931 #    12 => 'OOO',
 932 #    13 => 'PPP',
 933 #    14 => 'QQQ'
 934 #  },
 935 #  {
 936 #    QQQ => 14,
 937 #    PPP => 13,
 938 #    OOO => 12,
 939 #    NNN => 11,
 940 #    MMM => 10,
 941 #    LLL => 9,
 942 #    KKK => 8,
 943 #    JJJ => 7,
 944 #    III => 6
 945 #  }
 946 #];
 947 EOT
 948
 949 TEST q(Data::Dumper->new([[$c, $d]])->Dump;), "more sortkeys sub";
 950 # the XS code does number values as strings
 951 $WANT =~ s/ (\d+)(,?)$/ '$1'$2/gm;
 952 TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;), "more sortkeys sub (XS)"
 953         if $XS;
 954 }
 955
 956 {
 957   local $Data::Dumper::Deparse = 1;
 958   local $Data::Dumper::Indent = 2;
 959
 960 ############# 211
 961 ##
 962   $WANT = <<'EOT';
 963 #$VAR1 = {
 964 #          foo => sub {
 965 #                     print 'foo';
 966 #                 }
 967 #        };
 968 EOT
 969
 970   if(" $Config{'extensions'} " !~ m[ B ]) {
 971     SKIP_TEST "Perl configured without B module";
 972   } else {
 973     TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump);
 974   }
 975 }
 976
 977 ############# 214
 978 ##
 979
 980 # This is messy.
 981 # The controls (bare numbers) are stored either as integers or floating point.
 982 # [depending on whether the tokeniser sees things like ".".
 983 # The peephole optimiser only runs for constant folding, not single constants,
 984 # so I already have some NVs, some IVs
 985 # The string versions are not. They are all PV
 986
 987 # This is arguably all far too chummy with the implementation, but I really
 988 # want to ensure that we don't go wrong when flags on scalars get as side
 989 # effects of reading them.
 990
 991 # These tests are actually testing the precise output of the current
 992 # implementation, so will most likely fail if the implementation changes,
 993 # even if the new implementation produces different but correct results.
 994 # It would be nice to test for wrong answers, but I can't see how to do that,
 995 # so instead I'm checking for unexpected answers. (ie -2 becoming "-2" is not
 996 # wrong, but I can't see an easy, reliable way to code that knowledge)
 997
 998 # Numbers (seen by the tokeniser as numbers, stored as numbers.
 999   @numbers =
1000   (
1001    0, +1, -2, 3.0, +4.0, -5.0, 6.5, +7.5, -8.5,
1002     9,  +10,  -11,  12.0,  +13.0,  -14.0,  15.5,  +16.25,  -17.75,
1003   );
1004 # Strings
1005   @strings =
1006   (
1007    "0", "+1", "-2", "3.0", "+4.0", "-5.0", "6.5", "+7.5", "-8.5", " 9",
1008    " +10", " -11", " 12.0", " +13.0", " -14.0", " 15.5", " +16.25", " -17.75",
1009   );
1010
1011 # The perl code always does things the same way for numbers.
1012   $WANT_PL_N = <<'EOT';
1013 #$VAR1 = 0;
1014 #$VAR2 = 1;
1015 #$VAR3 = -2;
1016 #$VAR4 = 3;
1017 #$VAR5 = 4;
1018 #$VAR6 = -5;
1019 #$VAR7 = '6.5';
1020 #$VAR8 = '7.5';
1021 #$VAR9 = '-8.5';
1022 #$VAR10 = 9;
1023 #$VAR11 = 10;
1024 #$VAR12 = -11;
1025 #$VAR13 = 12;
1026 #$VAR14 = 13;
1027 #$VAR15 = -14;
1028 #$VAR16 = '15.5';
1029 #$VAR17 = '16.25';
1030 #$VAR18 = '-17.75';
1031 EOT
1032 # The perl code knows that 0 and -2 stringify exactly back to the strings,
1033 # so it dumps them as numbers, not strings.
1034   $WANT_PL_S = <<'EOT';
1035 #$VAR1 = 0;
1036 #$VAR2 = '+1';
1037 #$VAR3 = -2;
1038 #$VAR4 = '3.0';
1039 #$VAR5 = '+4.0';
1040 #$VAR6 = '-5.0';
1041 #$VAR7 = '6.5';
1042 #$VAR8 = '+7.5';
1043 #$VAR9 = '-8.5';
1044 #$VAR10 = ' 9';
1045 #$VAR11 = ' +10';
1046 #$VAR12 = ' -11';
1047 #$VAR13 = ' 12.0';
1048 #$VAR14 = ' +13.0';
1049 #$VAR15 = ' -14.0';
1050 #$VAR16 = ' 15.5';
1051 #$VAR17 = ' +16.25';
1052 #$VAR18 = ' -17.75';
1053 EOT
1054
1055 # The XS code differs.
1056 # These are the numbers as seen by the tokeniser. Constants aren't folded
1057 # (which makes IVs where possible) so values the tokeniser thought were
1058 # floating point are stored as NVs. The XS code outputs these as strings,
1059 # but as it has converted them from NVs, leading + signs will not be there.
1060   $WANT_XS_N = <<'EOT';
1061 #$VAR1 = 0;
1062 #$VAR2 = 1;
1063 #$VAR3 = -2;
1064 #$VAR4 = '3';
1065 #$VAR5 = '4';
1066 #$VAR6 = '-5';
1067 #$VAR7 = '6.5';
1068 #$VAR8 = '7.5';
1069 #$VAR9 = '-8.5';
1070 #$VAR10 = 9;
1071 #$VAR11 = 10;
1072 #$VAR12 = -11;
1073 #$VAR13 = '12';
1074 #$VAR14 = '13';
1075 #$VAR15 = '-14';
1076 #$VAR16 = '15.5';
1077 #$VAR17 = '16.25';
1078 #$VAR18 = '-17.75';
1079 EOT
1080
1081 # These are the strings as seen by the tokeniser. The XS code will output
1082 # these for all cases except where the scalar has been used in integer context
1083   $WANT_XS_S = <<'EOT';
1084 #$VAR1 = '0';
1085 #$VAR2 = '+1';
1086 #$VAR3 = '-2';
1087 #$VAR4 = '3.0';
1088 #$VAR5 = '+4.0';
1089 #$VAR6 = '-5.0';
1090 #$VAR7 = '6.5';
1091 #$VAR8 = '+7.5';
1092 #$VAR9 = '-8.5';
1093 #$VAR10 = ' 9';
1094 #$VAR11 = ' +10';
1095 #$VAR12 = ' -11';
1096 #$VAR13 = ' 12.0';
1097 #$VAR14 = ' +13.0';
1098 #$VAR15 = ' -14.0';
1099 #$VAR16 = ' 15.5';
1100 #$VAR17 = ' +16.25';
1101 #$VAR18 = ' -17.75';
1102 EOT
1103
1104 # These are the numbers as IV-ized by &
1105 # These will differ from WANT_XS_N because now IV flags will be set on all
1106 # values that were actually integer, and the XS code will then output these
1107 # as numbers not strings.
1108   $WANT_XS_I = <<'EOT';
1109 #$VAR1 = 0;
1110 #$VAR2 = 1;
1111 #$VAR3 = -2;
1112 #$VAR4 = 3;
1113 #$VAR5 = 4;
1114 #$VAR6 = -5;
1115 #$VAR7 = '6.5';
1116 #$VAR8 = '7.5';
1117 #$VAR9 = '-8.5';
1118 #$VAR10 = 9;
1119 #$VAR11 = 10;
1120 #$VAR12 = -11;
1121 #$VAR13 = 12;
1122 #$VAR14 = 13;
1123 #$VAR15 = -14;
1124 #$VAR16 = '15.5';
1125 #$VAR17 = '16.25';
1126 #$VAR18 = '-17.75';
1127 EOT
1128
1129 # Some of these tests will be redundant.
1130 @numbers_s = @numbers_i = @numbers_is = @numbers_n = @numbers_ns = @numbers_ni
1131   = @numbers_nis = @numbers;
1132 @strings_s = @strings_i = @strings_is = @strings_n = @strings_ns = @strings_ni
1133   = @strings_nis = @strings;
1134 # Use them in an integer context
1135 foreach (@numbers_i, @numbers_ni, @numbers_nis, @numbers_is,
1136          @strings_i, @strings_ni, @strings_nis, @strings_is) {
1137   my $b = sprintf "%d", $_;
1138 }
1139 # Use them in a floating point context
1140 foreach (@numbers_n, @numbers_ni, @numbers_nis, @numbers_ns,
1141          @strings_n, @strings_ni, @strings_nis, @strings_ns) {
1142   my $b = sprintf "%e", $_;
1143 }
1144 # Use them in a string context
1145 foreach (@numbers_s, @numbers_is, @numbers_nis, @numbers_ns,
1146          @strings_s, @strings_is, @strings_nis, @strings_ns) {
1147   my $b = sprintf "%s", $_;
1148 }
1149
1150 # use Devel::Peek; Dump ($_) foreach @vanilla_c;
1151
1152 $WANT=$WANT_PL_N;
1153 TEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers';
1154 TEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV';
1155 TEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV';
1156 TEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV';
1157 TEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV';
1158 TEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV';
1159 TEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV';
1160 TEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV';
1161 $WANT=$WANT_PL_S;
1162 TEST q(Data::Dumper->new(\@strings)->Dump), 'Strings';
1163 TEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV';
1164 TEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV';
1165 TEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV';
1166 TEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV';
1167 TEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV';
1168 TEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV';
1169 TEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV';
1170 if ($XS) {
1171  my $nv_preserves_uv = defined $Config{d_nv_preserves_uv};
1172  my $nv_preserves_uv_4bits = exists($Config{nv_preserves_uv_bits}) && $Config{nv_preserves_uv_bits} >= 4;
1173   $WANT=$WANT_XS_N;
1174   TEST q(Data::Dumper->new(\@numbers)->Dumpxs), 'XS Numbers';
1175   TEST q(Data::Dumper->new(\@numbers_s)->Dumpxs), 'XS Numbers PV';
1176  if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1177   $WANT=$WANT_XS_I;
1178   TEST q(Data::Dumper->new(\@numbers_i)->Dumpxs), 'XS Numbers IV';
1179   TEST q(Data::Dumper->new(\@numbers_is)->Dumpxs), 'XS Numbers IV,PV';
1180  } else {
1181   SKIP_TEST "NV does not preserve 4bits";
1182   SKIP_TEST "NV does not preserve 4bits";
1183  }
1184   $WANT=$WANT_XS_N;
1185   TEST q(Data::Dumper->new(\@numbers_n)->Dumpxs), 'XS Numbers NV';
1186   TEST q(Data::Dumper->new(\@numbers_ns)->Dumpxs), 'XS Numbers NV,PV';
1187  if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1188   $WANT=$WANT_XS_I;
1189   TEST q(Data::Dumper->new(\@numbers_ni)->Dumpxs), 'XS Numbers NV,IV';
1190   TEST q(Data::Dumper->new(\@numbers_nis)->Dumpxs), 'XS Numbers NV,IV,PV';
1191  } else {
1192   SKIP_TEST "NV does not preserve 4bits";
1193   SKIP_TEST "NV does not preserve 4bits";
1194  }
1195
1196   $WANT=$WANT_XS_S;
1197   TEST q(Data::Dumper->new(\@strings)->Dumpxs), 'XS Strings';
1198   TEST q(Data::Dumper->new(\@strings_s)->Dumpxs), 'XS Strings PV';
1199   # This one used to really mess up. New code actually emulates the .pm code
1200   $WANT=$WANT_PL_S;
1201   TEST q(Data::Dumper->new(\@strings_i)->Dumpxs), 'XS Strings IV';
1202   TEST q(Data::Dumper->new(\@strings_is)->Dumpxs), 'XS Strings IV,PV';
1203  if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1204   $WANT=$WANT_XS_S;
1205   TEST q(Data::Dumper->new(\@strings_n)->Dumpxs), 'XS Strings NV';
1206   TEST q(Data::Dumper->new(\@strings_ns)->Dumpxs), 'XS Strings NV,PV';
1207  } else {
1208   SKIP_TEST "NV does not preserve 4bits";
1209   SKIP_TEST "NV does not preserve 4bits";
1210  }
1211   # This one used to really mess up. New code actually emulates the .pm code
1212   $WANT=$WANT_PL_S;
1213   TEST q(Data::Dumper->new(\@strings_ni)->Dumpxs), 'XS Strings NV,IV';
1214   TEST q(Data::Dumper->new(\@strings_nis)->Dumpxs), 'XS Strings NV,IV,PV';
1215 }
1216
1217 {
1218   $a = "1\n";
1219 ############# 310
1220 ## Perl code was using /...$/ and hence missing the \n.
1221   $WANT = <<'EOT';
1222 my $VAR1 = '42
1223 ';
1224 EOT
1225
1226   # Can't pad with # as the output has an embedded newline.
1227   local $Data::Dumper::Pad = "my ";
1228   TEST q(Data::Dumper->Dump(["42\n"])), "number with trailing newline";
1229   TEST q(Data::Dumper->Dumpxs(["42\n"])), "XS number with trailing newline"
1230         if $XS;
1231 }
1232
1233 {
1234   @a = (
1235         999999999,
1236         1000000000,
1237         9999999999,
1238         10000000000,
1239         -999999999,
1240         -1000000000,
1241         -9999999999,
1242         -10000000000,
1243         4294967295,
1244         4294967296,
1245         -2147483648,
1246         -2147483649,
1247         );
1248 ############# 316
1249 ## Perl code flips over at 10 digits.
1250   $WANT = <<'EOT';
1251 #$VAR1 = 999999999;
1252 #$VAR2 = '1000000000';
1253 #$VAR3 = '9999999999';
1254 #$VAR4 = '10000000000';
1255 #$VAR5 = -999999999;
1256 #$VAR6 = '-1000000000';
1257 #$VAR7 = '-9999999999';
1258 #$VAR8 = '-10000000000';
1259 #$VAR9 = '4294967295';
1260 #$VAR10 = '4294967296';
1261 #$VAR11 = '-2147483648';
1262 #$VAR12 = '-2147483649';
1263 EOT
1264
1265   TEST q(Data::Dumper->Dump(\@a)), "long integers";
1266
1267   if ($XS) {
1268 ## XS code flips over at 11 characters ("-" is a char) or larger than int.
1269     if (~0 == 0xFFFFFFFF) {
1270       # 32 bit system
1271       $WANT = <<'EOT';
1272 #$VAR1 = 999999999;
1273 #$VAR2 = 1000000000;
1274 #$VAR3 = '9999999999';
1275 #$VAR4 = '10000000000';
1276 #$VAR5 = -999999999;
1277 #$VAR6 = '-1000000000';
1278 #$VAR7 = '-9999999999';
1279 #$VAR8 = '-10000000000';
1280 #$VAR9 = 4294967295;
1281 #$VAR10 = '4294967296';
1282 #$VAR11 = '-2147483648';
1283 #$VAR12 = '-2147483649';
1284 EOT
1285     } else {
1286       $WANT = <<'EOT';
1287 #$VAR1 = 999999999;
1288 #$VAR2 = 1000000000;
1289 #$VAR3 = 9999999999;
1290 #$VAR4 = '10000000000';
1291 #$VAR5 = -999999999;
1292 #$VAR6 = '-1000000000';
1293 #$VAR7 = '-9999999999';
1294 #$VAR8 = '-10000000000';
1295 #$VAR9 = 4294967295;
1296 #$VAR10 = 4294967296;
1297 #$VAR11 = '-2147483648';
1298 #$VAR12 = '-2147483649';
1299 EOT
1300     }
1301     TEST q(Data::Dumper->Dumpxs(\@a)), "XS long integers";
1302   }
1303 }
1304
1305 #XXX}
1306 {
1307     if ($Is_ebcdic) {
1308         $b = "Bad. XS didn't escape dollar sign";
1309 ############# 322
1310         $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1311 #\$VAR1 = '\$b\"\@\\\\\xB1';
1312 EOT
1313         $a = "\$b\"\@\\\xB1\x{100}";
1314         chop $a;
1315         TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1316         if ($XS) {
1317             $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1318 #$VAR1 = "\$b\"\@\\\x{b1}";
1319 EOT
1320             TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1321         }
1322     } else {
1323         $b = "Bad. XS didn't escape dollar sign";
1324 ############# 322
1325         $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1326 #\$VAR1 = '\$b\"\@\\\\\xA3';
1327 EOT
1328
1329         $a = "\$b\"\@\\\xA3\x{100}";
1330         chop $a;
1331         TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1332         if ($XS) {
1333             $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1334 #$VAR1 = "\$b\"\@\\\x{a3}";
1335 EOT
1336             TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1337         }
1338   }
1339   # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
1340 ############# 328
1341   $WANT = <<'EOT';
1342 #$VAR1 = '$b"';
1343 EOT
1344
1345   $a = "\$b\"\x{100}";
1346   chop $a;
1347   TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1348   if ($XS) {
1349     TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1350   }
1351
1352
1353   # XS used to produce 'D'oh!' which is well, D'oh!
1354   # Andreas found this one, which in turn discovered the previous two.
1355 ############# 334
1356   $WANT = <<'EOT';
1357 #$VAR1 = 'D\'oh!';
1358 EOT
1359
1360   $a = "D'oh!\x{100}";
1361   chop $a;
1362   TEST q(Data::Dumper->Dump([$a])), "utf8 flag with '";
1363   if ($XS) {
1364     TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '";
1365   }
1366 }
1367
1368 # Jarkko found that -Mutf8 caused some tests to fail.  Turns out that there
1369 # was an otherwise untested code path in the XS for utf8 hash keys with purity
1370 # 1
1371
1372 {
1373   $WANT = <<'EOT';
1374 #$ping = \*::ping;
1375 #*::ping = \5;
1376 #*::ping = {
1377 #  "\x{decaf}\x{decaf}\x{decaf}\x{decaf}" => do{my $o}
1378 #};
1379 #*::ping{HASH}->{"\x{decaf}\x{decaf}\x{decaf}\x{decaf}"} = *::ping{SCALAR};
1380 #%pong = %{*::ping{HASH}};
1381 EOT
1382   local $Data::Dumper::Purity = 1;
1383   local $Data::Dumper::Sortkeys;
1384   $ping = 5;
1385   %ping = (chr (0xDECAF) x 4  =>\$ping);
1386   for $Data::Dumper::Sortkeys (0, 1) {
1387     if($] >= 5.007) {
1388       TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
1389       TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
1390     } else {
1391       SKIP_TEST "Incomplete support for UTF-8 in old perls";
1392       SKIP_TEST "Incomplete support for UTF-8 in old perls";
1393     }
1394   }
1395 }
1396
1397 # XS for quotekeys==0 was not being defensive enough against utf8 flagged
1398 # scalars
1399
1400 {
1401   $WANT = <<'EOT';
1402 #$VAR1 = {
1403 #  perl => 'rocks'
1404 #};
1405 EOT
1406   local $Data::Dumper::Quotekeys = 0;
1407   my $k = 'perl' . chr 256;
1408   chop $k;
1409   %foo = ($k => 'rocks');
1410
1411   TEST q(Data::Dumper->Dump([\\%foo])), "quotekeys == 0 for utf8 flagged ASCII";
1412   TEST q(Data::Dumper->Dumpxs([\\%foo])),
1413     "XS quotekeys == 0 for utf8 flagged ASCII" if $XS;
1414 }
1415 ############# 358
1416 {
1417   $WANT = <<'EOT';
1418 #$VAR1 = [
1419 #  undef,
1420 #  undef,
1421 #  1
1422 #];
1423 EOT
1424     @foo = ();
1425     $foo[2] = 1;
1426     TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>';
1427     TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS;
1428 }
1429
1430 ############# 364
1431 # Make sure $obj->Dumpxs returns the right thing in list context. This was
1432 # broken by the initial attempt to fix [perl #74170].
1433 $WANT = <<'EOT';
1434 #$VAR1 = [];
1435 EOT
1436 TEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs),
1437     '$obj->Dumpxs in list context'
1438  if $XS;
1439
1440 ############# 366
1441 {
1442   $WANT = <<'EOT';
1443 #$VAR1 = [
1444 #  "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"
1445 #];
1446 EOT
1447
1448   $foo = [ join "", map chr, 0..255 ];
1449   local $Data::Dumper::Useqq = 1;
1450   TEST q(Dumper($foo)), 'All latin1 characters';
1451   TEST q(Data::Dumper::DumperX($foo)) if $XS;
1452 }
1453
1454 ############# 372
1455 {
1456   $WANT = <<'EOT';
1457 #$VAR1 = [
1458 #  "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\x{80}\x{81}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8d}\x{8e}\x{8f}\x{90}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9d}\x{9e}\x{9f}\x{a0}\x{a1}\x{a2}\x{a3}\x{a4}\x{a5}\x{a6}\x{a7}\x{a8}\x{a9}\x{aa}\x{ab}\x{ac}\x{ad}\x{ae}\x{af}\x{b0}\x{b1}\x{b2}\x{b3}\x{b4}\x{b5}\x{b6}\x{b7}\x{b8}\x{b9}\x{ba}\x{bb}\x{bc}\x{bd}\x{be}\x{bf}\x{c0}\x{c1}\x{c2}\x{c3}\x{c4}\x{c5}\x{c6}\x{c7}\x{c8}\x{c9}\x{ca}\x{cb}\x{cc}\x{cd}\x{ce}\x{cf}\x{d0}\x{d1}\x{d2}\x{d3}\x{d4}\x{d5}\x{d6}\x{d7}\x{d8}\x{d9}\x{da}\x{db}\x{dc}\x{dd}\x{de}\x{df}\x{e0}\x{e1}\x{e2}\x{e3}\x{e4}\x{e5}\x{e6}\x{e7}\x{e8}\x{e9}\x{ea}\x{eb}\x{ec}\x{ed}\x{ee}\x{ef}\x{f0}\x{f1}\x{f2}\x{f3}\x{f4}\x{f5}\x{f6}\x{f7}\x{f8}\x{f9}\x{fa}\x{fb}\x{fc}\x{fd}\x{fe}\x{ff}\x{20ac}"
1459 #];
1460 EOT
1461
1462   $foo = [ join "", map chr, 0..255, 0x20ac ];
1463   local $Data::Dumper::Useqq = 1;
1464   if ($] < 5.007) {
1465     print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3;
1466   }
1467   else {
1468     TEST q(Dumper($foo)),
1469          'All latin1 characters with utf8 flag including a wide character';
1470   }
1471   TEST q(Data::Dumper::DumperX($foo)) if $XS;
1472 }
1473
1474 ############# 378
1475 {
1476   # If XS cannot load, the pure-Perl version cannot deparse vstrings with
1477   # underscores properly.  In 5.8.0, vstrings are just strings.
1478   my $no_vstrings = <<'NOVSTRINGS';
1479 #$a = \'ABC';
1480 #$b = \'ABC';
1481 #$c = \'ABC';
1482 #$d = \'ABC';
1483 NOVSTRINGS
1484   my $vstrings_corr = <<'VSTRINGS_CORRECT';
1485 #$a = \v65.66.67;
1486 #$b = \v65.66.067;
1487 #$c = \v65.66.6_7;
1488 #$d = \'ABC';
1489 VSTRINGS_CORRECT
1490   $WANT = $] <= 5.0080001
1491           ? $no_vstrings
1492           : $vstrings_corr;
1493
1494   @::_v = (
1495     \v65.66.67,
1496     \($] < 5.007 ? v65.66.67 : eval 'v65.66.067'),
1497     \v65.66.6_7,
1498     \~v190.189.188
1499   );
1500   if ($] >= 5.010) {
1501     TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings';
1502     TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings'
1503       if $XS;
1504   }
1505   else { # Skip tests before 5.10. vstrings considered funny before
1506     SKIP_TEST "vstrings considered funny before 5.10.0";
1507     SKIP_TEST "vstrings considered funny before 5.10.0 (XS)"
1508       if $XS;
1509   }
1510 }
1511
1512 ############# 384
1513 {
1514   # [perl #107372] blessed overloaded globs
1515   $WANT = <<'EOW';
1516 #$VAR1 = bless( \*::finkle, 'overtest' );
1517 EOW
1518   {
1519     package overtest;
1520     use overload fallback=>1, q\""\=>sub{"oaoaa"};
1521   }
1522   TEST q(Data::Dumper->Dump([bless \*finkle, "overtest"])),
1523     'blessed overloaded globs';
1524   TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)'
1525     if $XS;
1526 }
1527 ############# 390
1528 {
1529   # [perl #74798] uncovered behaviour
1530   $WANT = <<'EOW';
1531 #$VAR1 = "\0000";
1532 EOW
1533   local $Data::Dumper::Useqq = 1;
1534   TEST q(Data::Dumper->Dump(["\x000"])),
1535     "\\ octal followed by digit";
1536   TEST q(Data::Dumper->Dumpxs(["\x000"])), '\\ octal followed by digit (xs)'
1537     if $XS;
1538
1539   $WANT = <<'EOW';
1540 #$VAR1 = "\x{100}\0000";
1541 EOW
1542   local $Data::Dumper::Useqq = 1;
1543   TEST q(Data::Dumper->Dump(["\x{100}\x000"])),
1544     "\\ octal followed by digit unicode";
1545   TEST q(Data::Dumper->Dumpxs(["\x{100}\x000"])), '\\ octal followed by digit unicode (xs)'
1546     if $XS;
1547
1548
1549   $WANT = <<'EOW';
1550 #$VAR1 = "\0\x{660}";
1551 EOW
1552   TEST q(Data::Dumper->Dump(["\\x00\\x{0660}"])),
1553     "\\ octal followed by unicode digit";
1554   TEST q(Data::Dumper->Dumpxs(["\\x00\\x{0660}"])), '\\ octal followed by unicode digit (xs)'
1555     if $XS;
1556
1557   # [perl #118933 - handling of digits
1558 $WANT = <<'EOW';
1559 #$VAR1 = 0;
1560 #$VAR2 = 1;
1561 #$VAR3 = 90;
1562 #$VAR4 = -10;
1563 #$VAR5 = "010";
1564 #$VAR6 = 112345678;
1565 #$VAR7 = "1234567890";
1566 EOW
1567   TEST q(Data::Dumper->Dump([0, 1, 90, -10, "010", "112345678", "1234567890" ])),
1568     "numbers and number-like scalars";
1569
1570   TEST q(Data::Dumper->Dumpxs([0, 1, 90, -10, "010", "112345678", "1234567890" ])),
1571     "numbers and number-like scalars"
1572     if $XS;
1573 }
1574 ############# 426
1575 {
1576   # [perl #82948]
1577   # re::regexp_pattern was moved to universal.c in v5.10.0-252-g192c1e2
1578   # and apparently backported to maint-5.10
1579   $WANT = $] > 5.010 ? <<'NEW' : <<'OLD';
1580 #$VAR1 = qr/abc/;
1581 #$VAR2 = qr/abc/i;
1582 NEW
1583 #$VAR1 = qr/(?-xism:abc)/;
1584 #$VAR2 = qr/(?i-xsm:abc)/;
1585 OLD
1586   TEST q(Data::Dumper->Dump([ qr/abc/, qr/abc/i ])), "qr//";
1587   TEST q(Data::Dumper->Dumpxs([ qr/abc/, qr/abc/i ])), "qr// xs"
1588     if $XS;
1589 }
1590 ############# 432