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