t/lib/dumper.t

   1 #!./perl -w
   2 #
   3 # testsuite for Data::Dumper
   4 #
   5
   6 BEGIN {
   7     chdir 't' if -d 't';
   8     unshift @INC, '../lib' if -d '../lib';
   9 }
  10
  11 use Data::Dumper;
  12
  13 $Data::Dumper::Pad = "#";
  14 my $TMAX;
  15 my $XS;
  16 my $TNUM = 0;
  17 my $WANT = '';
  18
  19 sub TEST {
  20   my $string = shift;
  21   my $t = eval $string;
  22   ++$TNUM;
  23   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
  24         : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
  25
  26   ++$TNUM;
  27   eval "$t";
  28   print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
  29
  30   $t = eval $string;
  31   ++$TNUM;
  32   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
  33         : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
  34 }
  35
  36 if (defined &Data::Dumper::Dumpxs) {
  37   print "### XS extension loaded, will run XS tests\n";
  38   $TMAX = 162; $XS = 1;
  39 }
  40 else {
  41   print "### XS extensions not loaded, will NOT run XS tests\n";
  42   $TMAX = 81; $XS = 0;
  43 }
  44
  45 print "1..$TMAX\n";
  46
  47 #############
  48 #############
  49
  50 @c = ('c');
  51 $c = \@c;
  52 $b = {};
  53 $a = [1, $b, $c];
  54 $b->{a} = $a;
  55 $b->{b} = $a->[1];
  56 $b->{c} = $a->[2];
  57
  58 ############# 1
  59 ##
  60 $WANT = <<'EOT';
  61 #$a = [
  62 #       1,
  63 #       {
  64 #         'a' => $a,
  65 #         'b' => $a->[1],
  66 #         'c' => [
  67 #                  'c'
  68 #                ]
  69 #       },
  70 #       $a->[1]{'c'}
  71 #     ];
  72 #$b = $a->[1];
  73 #$c = $a->[1]{'c'};
  74 EOT
  75
  76 TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
  77 TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
  78
  79
  80 ############# 7
  81 ##
  82 $WANT = <<'EOT';
  83 #@a = (
  84 #       1,
  85 #       {
  86 #         'a' => [],
  87 #         'b' => {},
  88 #         'c' => [
  89 #                  'c'
  90 #                ]
  91 #       },
  92 #       []
  93 #     );
  94 #$a[1]{'a'} = \@a;
  95 #$a[1]{'b'} = $a[1];
  96 #$a[2] = $a[1]{'c'};
  97 #$b = $a[1];
  98 EOT
  99
 100 $Data::Dumper::Purity = 1;         # fill in the holes for eval
 101 TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
 102 TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
 103
 104 ############# 13
 105 ##
 106 $WANT = <<'EOT';
 107 #%b = (
 108 #       'a' => [
 109 #                1,
 110 #                {},
 111 #                [
 112 #                  'c'
 113 #                ]
 114 #              ],
 115 #       'b' => {},
 116 #       'c' => []
 117 #     );
 118 #$b{'a'}[1] = \%b;
 119 #$b{'b'} = \%b;
 120 #$b{'c'} = $b{'a'}[2];
 121 #$a = $b{'a'};
 122 EOT
 123
 124 TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
 125 TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
 126
 127 ############# 19
 128 ##
 129 $WANT = <<'EOT';
 130 #$a = [
 131 #  1,
 132 #  {
 133 #    'a' => [],
 134 #    'b' => {},
 135 #    'c' => []
 136 #  },
 137 #  []
 138 #];
 139 #$a->[1]{'a'} = $a;
 140 #$a->[1]{'b'} = $a->[1];
 141 #$a->[1]{'c'} = \@c;
 142 #$a->[2] = \@c;
 143 #$b = $a->[1];
 144 EOT
 145
 146 $Data::Dumper::Indent = 1;
 147 TEST q(
 148        $d = Data::Dumper->new([$a,$b], [qw(a b)]);
 149        $d->Seen({'*c' => $c});
 150        $d->Dump;
 151       );
 152 if ($XS) {
 153   TEST q(
 154          $d = Data::Dumper->new([$a,$b], [qw(a b)]);
 155          $d->Seen({'*c' => $c});
 156          $d->Dumpxs;
 157         );
 158 }
 159
 160
 161 ############# 25
 162 ##
 163 $WANT = <<'EOT';
 164 #$a = [
 165 #       #0
 166 #       1,
 167 #       #1
 168 #       {
 169 #         a => $a,
 170 #         b => $a->[1],
 171 #         c => [
 172 #                #0
 173 #                'c'
 174 #              ]
 175 #       },
 176 #       #2
 177 #       $a->[1]{c}
 178 #     ];
 179 #$b = $a->[1];
 180 EOT
 181
 182 $d->Indent(3);
 183 $d->Purity(0)->Quotekeys(0);
 184 TEST q( $d->Reset; $d->Dump );
 185
 186 TEST q( $d->Reset; $d->Dumpxs ) if $XS;
 187
 188 ############# 31
 189 ##
 190 $WANT = <<'EOT';
 191 #$VAR1 = [
 192 #  1,
 193 #  {
 194 #    'a' => [],
 195 #    'b' => {},
 196 #    'c' => [
 197 #      'c'
 198 #    ]
 199 #  },
 200 #  []
 201 #];
 202 #$VAR1->[1]{'a'} = $VAR1;
 203 #$VAR1->[1]{'b'} = $VAR1->[1];
 204 #$VAR1->[2] = $VAR1->[1]{'c'};
 205 EOT
 206
 207 TEST q(Dumper($a));
 208 TEST q(Data::Dumper::DumperX($a)) if $XS;
 209
 210 ############# 37
 211 ##
 212 $WANT = <<'EOT';
 213 #[
 214 #  1,
 215 #  {
 216 #    a => $VAR1,
 217 #    b => $VAR1->[1],
 218 #    c => [
 219 #      'c'
 220 #    ]
 221 #  },
 222 #  $VAR1->[1]{c}
 223 #]
 224 EOT
 225
 226 {
 227   local $Data::Dumper::Purity = 0;
 228   local $Data::Dumper::Quotekeys = 0;
 229   local $Data::Dumper::Terse = 1;
 230   TEST q(Dumper($a));
 231   TEST q(Data::Dumper::DumperX($a)) if $XS;
 232 }
 233
 234
 235 ############# 43
 236 ##
 237 $WANT = <<'EOT';
 238 #$VAR1 = {
 239 #  "abc\0'\efg" => "mno\0"
 240 #};
 241 EOT
 242
 243 $foo = { "abc\000\'\efg" => "mno\000" };
 244 {
 245   local $Data::Dumper::Useqq = 1;
 246   TEST q(Dumper($foo));
 247 }
 248
 249   $WANT = <<"EOT";
 250 #\$VAR1 = {
 251 #  'abc\0\\'\efg' => 'mno\0'
 252 #};
 253 EOT
 254
 255   {
 256     local $Data::Dumper::Useqq = 1;
 257     TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
 258   }
 259
 260
 261
 262 #############
 263 #############
 264
 265 {
 266   package main;
 267   use Data::Dumper;
 268   $foo = 5;
 269   @foo = (10,\*foo);
 270   %foo = (a=>1,b=>\$foo,c=>\@foo);
 271   $foo{d} = \%foo;
 272   $foo[2] = \%foo;
 273
 274 ############# 49
 275 ##
 276   $WANT = <<'EOT';
 277 #$foo = \*::foo;
 278 #*::foo = \5;
 279 #*::foo = [
 280 #           #0
 281 #           10,
 282 #           #1
 283 #           '',
 284 #           #2
 285 #           {
 286 #             'a' => 1,
 287 #             'b' => '',
 288 #             'c' => [],
 289 #             'd' => {}
 290 #           }
 291 #         ];
 292 #*::foo{ARRAY}->[1] = $foo;
 293 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
 294 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
 295 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
 296 #*::foo = *::foo{ARRAY}->[2];
 297 #@bar = @{*::foo{ARRAY}};
 298 #%baz = %{*::foo{ARRAY}->[2]};
 299 EOT
 300
 301   $Data::Dumper::Purity = 1;
 302   $Data::Dumper::Indent = 3;
 303   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
 304   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
 305
 306 ############# 55
 307 ##
 308   $WANT = <<'EOT';
 309 #$foo = \*::foo;
 310 #*::foo = \5;
 311 #*::foo = [
 312 #  10,
 313 #  '',
 314 #  {
 315 #    'a' => 1,
 316 #    'b' => '',
 317 #    'c' => [],
 318 #    'd' => {}
 319 #  }
 320 #];
 321 #*::foo{ARRAY}->[1] = $foo;
 322 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
 323 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
 324 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
 325 #*::foo = *::foo{ARRAY}->[2];
 326 #$bar = *::foo{ARRAY};
 327 #$baz = *::foo{ARRAY}->[2];
 328 EOT
 329
 330   $Data::Dumper::Indent = 1;
 331   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
 332   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
 333
 334 ############# 61
 335 ##
 336   $WANT = <<'EOT';
 337 #@bar = (
 338 #  10,
 339 #  \*::foo,
 340 #  {}
 341 #);
 342 #*::foo = \5;
 343 #*::foo = \@bar;
 344 #*::foo = {
 345 #  'a' => 1,
 346 #  'b' => '',
 347 #  'c' => [],
 348 #  'd' => {}
 349 #};
 350 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
 351 #*::foo{HASH}->{'c'} = \@bar;
 352 #*::foo{HASH}->{'d'} = *::foo{HASH};
 353 #$bar[2] = *::foo{HASH};
 354 #%baz = %{*::foo{HASH}};
 355 #$foo = $bar[1];
 356 EOT
 357
 358   TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
 359   TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
 360
 361 ############# 67
 362 ##
 363   $WANT = <<'EOT';
 364 #$bar = [
 365 #  10,
 366 #  \*::foo,
 367 #  {}
 368 #];
 369 #*::foo = \5;
 370 #*::foo = $bar;
 371 #*::foo = {
 372 #  'a' => 1,
 373 #  'b' => '',
 374 #  'c' => [],
 375 #  'd' => {}
 376 #};
 377 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
 378 #*::foo{HASH}->{'c'} = $bar;
 379 #*::foo{HASH}->{'d'} = *::foo{HASH};
 380 #$bar->[2] = *::foo{HASH};
 381 #$baz = *::foo{HASH};
 382 #$foo = $bar->[1];
 383 EOT
 384
 385   TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
 386   TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
 387
 388 ############# 73
 389 ##
 390   $WANT = <<'EOT';
 391 #$foo = \*::foo;
 392 #@bar = (
 393 #  10,
 394 #  $foo,
 395 #  {
 396 #    a => 1,
 397 #    b => \5,
 398 #    c => \@bar,
 399 #    d => $bar[2]
 400 #  }
 401 #);
 402 #%baz = %{$bar[2]};
 403 EOT
 404
 405   $Data::Dumper::Purity = 0;
 406   $Data::Dumper::Quotekeys = 0;
 407   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
 408   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
 409
 410 ############# 79
 411 ##
 412   $WANT = <<'EOT';
 413 #$foo = \*::foo;
 414 #$bar = [
 415 #  10,
 416 #  $foo,
 417 #  {
 418 #    a => 1,
 419 #    b => \5,
 420 #    c => $bar,
 421 #    d => $bar->[2]
 422 #  }
 423 #];
 424 #$baz = $bar->[2];
 425 EOT
 426
 427   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
 428   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
 429
 430 }
 431
 432 #############
 433 #############
 434 {
 435   package main;
 436   @dogs = ( 'Fido', 'Wags' );
 437   %kennel = (
 438             First => \$dogs[0],
 439             Second =>  \$dogs[1],
 440            );
 441   $dogs[2] = \%kennel;
 442   $mutts = \%kennel;
 443   $mutts = $mutts;         # avoid warning
 444
 445 ############# 85
 446 ##
 447   $WANT = <<'EOT';
 448 #%kennels = (
 449 #  First => \'Fido',
 450 #  Second => \'Wags'
 451 #);
 452 #@dogs = (
 453 #  ${$kennels{First}},
 454 #  ${$kennels{Second}},
 455 #  \%kennels
 456 #);
 457 #%mutts = %kennels;
 458 EOT
 459
 460   TEST q(
 461          $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
 462                                 [qw(*kennels *dogs *mutts)] );
 463          $d->Dump;
 464         );
 465   if ($XS) {
 466     TEST q(
 467            $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
 468                                   [qw(*kennels *dogs *mutts)] );
 469            $d->Dumpxs;
 470           );
 471   }
 472
 473 ############# 91
 474 ##
 475   $WANT = <<'EOT';
 476 #%kennels = %kennels;
 477 #@dogs = @dogs;
 478 #%mutts = %kennels;
 479 EOT
 480
 481   TEST q($d->Dump);
 482   TEST q($d->Dumpxs) if $XS;
 483
 484 ############# 97
 485 ##
 486   $WANT = <<'EOT';
 487 #%kennels = (
 488 #  First => \'Fido',
 489 #  Second => \'Wags'
 490 #);
 491 #@dogs = (
 492 #  ${$kennels{First}},
 493 #  ${$kennels{Second}},
 494 #  \%kennels
 495 #);
 496 #%mutts = %kennels;
 497 EOT
 498
 499
 500   TEST q($d->Reset; $d->Dump);
 501   if ($XS) {
 502     TEST q($d->Reset; $d->Dumpxs);
 503   }
 504
 505 ############# 103
 506 ##
 507   $WANT = <<'EOT';
 508 #@dogs = (
 509 #  'Fido',
 510 #  'Wags',
 511 #  {
 512 #    First => \$dogs[0],
 513 #    Second => \$dogs[1]
 514 #  }
 515 #);
 516 #%kennels = %{$dogs[2]};
 517 #%mutts = %{$dogs[2]};
 518 EOT
 519
 520   TEST q(
 521          $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
 522                                 [qw(*dogs *kennels *mutts)] );
 523          $d->Dump;
 524         );
 525   if ($XS) {
 526     TEST q(
 527            $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
 528                                   [qw(*dogs *kennels *mutts)] );
 529            $d->Dumpxs;
 530           );
 531   }
 532
 533 ############# 109
 534 ##
 535   TEST q($d->Reset->Dump);
 536   if ($XS) {
 537     TEST q($d->Reset->Dumpxs);
 538   }
 539
 540 ############# 115
 541 ##
 542   $WANT = <<'EOT';
 543 #@dogs = (
 544 #  'Fido',
 545 #  'Wags',
 546 #  {
 547 #    First => \'Fido',
 548 #    Second => \'Wags'
 549 #  }
 550 #);
 551 #%kennels = (
 552 #  First => \'Fido',
 553 #  Second => \'Wags'
 554 #);
 555 EOT
 556
 557   TEST q(
 558          $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
 559          $d->Deepcopy(1)->Dump;
 560         );
 561   if ($XS) {
 562     TEST q($d->Reset->Dumpxs);
 563   }
 564
 565 }
 566
 567 {
 568
 569 sub z { print "foo\n" }
 570 $c = [ \&z ];
 571
 572 ############# 121
 573 ##
 574   $WANT = <<'EOT';
 575 #$a = $b;
 576 #$c = [
 577 #  $b
 578 #];
 579 EOT
 580
 581 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
 582 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
 583         if $XS;
 584
 585 ############# 127
 586 ##
 587   $WANT = <<'EOT';
 588 #$a = \&b;
 589 #$c = [
 590 #  \&b
 591 #];
 592 EOT
 593
 594 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
 595 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
 596         if $XS;
 597
 598 ############# 133
 599 ##
 600   $WANT = <<'EOT';
 601 #*a = \&b;
 602 #@c = (
 603 #  \&b
 604 #);
 605 EOT
 606
 607 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
 608 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
 609         if $XS;
 610
 611 }
 612
 613 {
 614   $a = [];
 615   $a->[1] = \$a->[0];
 616
 617 ############# 139
 618 ##
 619   $WANT = <<'EOT';
 620 #@a = (
 621 #  undef,
 622 #  ''
 623 #);
 624 #$a[1] = \$a[0];
 625 EOT
 626
 627 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
 628 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
 629         if $XS;
 630 }
 631
 632 {
 633   $a = \\\\\'foo';
 634   $b = $$$a;
 635
 636 ############# 145
 637 ##
 638   $WANT = <<'EOT';
 639 #$a = \\\\\'foo';
 640 #$b = ${${$a}};
 641 EOT
 642
 643 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
 644 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
 645         if $XS;
 646 }
 647
 648 {
 649   $a = [{ a => \$b }, { b => undef }];
 650   $b = [{ c => \$b }, { d => \$a }];
 651
 652 ############# 151
 653 ##
 654   $WANT = <<'EOT';
 655 #$a = [
 656 #  {
 657 #    a => \[
 658 #        {
 659 #          c => ''
 660 #        },
 661 #        {
 662 #          d => \[]
 663 #        }
 664 #      ]
 665 #  },
 666 #  {
 667 #    b => undef
 668 #  }
 669 #];
 670 #${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
 671 #${${$a->[0]{a}}->[1]->{d}} = $a;
 672 #$b = ${$a->[0]{a}};
 673 EOT
 674
 675 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
 676 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
 677         if $XS;
 678 }
 679
 680 {
 681   $a = [[[[\\\\\'foo']]]];
 682   $b = $a->[0][0];
 683   $c = $${$b->[0][0]};
 684
 685 ############# 157
 686 ##
 687   $WANT = <<'EOT';
 688 #$a = [
 689 #  [
 690 #    [
 691 #      [
 692 #        \\\\\'foo'
 693 #      ]
 694 #    ]
 695 #  ]
 696 #];
 697 #$b = $a->[0][0];
 698 #$c = ${${$a->[0][0][0][0]}};
 699 EOT
 700
 701 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
 702 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
 703         if $XS;
 704 }