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