Integrate perlio:

[p5sagit/p5-mst-13.2.git] / t / lib / dumper.t

diff --git a/t/lib/dumper.t b/t/lib/dumper.t
index 063df83..10add1c 100755 (executable)
--- a/t/lib/dumper.t
+++ b/t/lib/dumper.t
@@ -5,10 +5,17 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib' if -d '../lib';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+      print "1..0 # Skip: Data::Dumper was not built\n";
+      exit 0;
+    }
 }
 
 use Data::Dumper;
+use Config;
+my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
 
 $Data::Dumper::Pad = "#";
 my $TMAX;
@@ -20,6 +27,16 @@ sub TEST {
   my $string = shift;
   my $t = eval $string;
   ++$TNUM;
+  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+      if ($WANT =~ /deadbeef/);
+  if ($Is_ebcdic) {
+      # these data need massaging with non ascii character sets
+      # because of hashing order differences
+      $WANT = join("\n",sort(split(/\n/,$WANT)));
+      $WANT =~ s/\,$//mg;
+      $t    = join("\n",sort(split(/\n/,$t)));
+      $t    =~ s/\,$//mg;
+  }
   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
        : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
 
@@ -29,17 +46,26 @@ sub TEST {
 
   $t = eval $string;
   ++$TNUM;
+  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+      if ($WANT =~ /deadbeef/);
+  if ($Is_ebcdic) {
+      # here too there are hashing order differences
+      $WANT = join("\n",sort(split(/\n/,$WANT)));
+      $WANT =~ s/\,$//mg;
+      $t    = join("\n",sort(split(/\n/,$t)));
+      $t    =~ s/\,$//mg;
+  }
   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
        : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
 }
 
 if (defined &Data::Dumper::Dumpxs) {
   print "### XS extension loaded, will run XS tests\n";
-  $TMAX = 162; $XS = 1;
+  $TMAX = 186; $XS = 1;
 }
 else {
   print "### XS extensions not loaded, will NOT run XS tests\n";
-  $TMAX = 81; $XS = 0;
+  $TMAX = 93; $XS = 0;
 }
 
 print "1..$TMAX\n";
@@ -61,11 +87,11 @@ $WANT = <<'EOT';
 #$a = [
 #       1,
 #       {
-#         'a' => $a,
-#         'b' => $a->[1],
 #         'c' => [
 #                  'c'
-#                ]
+#                ],
+#         'a' => $a,
+#         'b' => $a->[1]
 #       },
 #       $a->[1]{'c'}
 #     ];
@@ -83,11 +109,11 @@ $WANT = <<'EOT';
 #@a = (
 #       1,
 #       {
-#         'a' => [],
-#         'b' => {},
 #         'c' => [
 #                  'c'
-#                ]
+#                ],
+#         'a' => [],
+#         'b' => {}
 #       },
 #       []
 #     );
@@ -105,19 +131,19 @@ TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
 ##
 $WANT = <<'EOT';
 #%b = (
+#       'c' => [
+#                'c'
+#              ],
 #       'a' => [
 #                1,
 #                {},
-#                [
-#                  'c'
-#                ]
+#                []
 #              ],
-#       'b' => {},
-#       'c' => []
+#       'b' => {}
 #     );
 #$b{'a'}[1] = \%b;
+#$b{'a'}[2] = $b{'c'};
 #$b{'b'} = \%b;
-#$b{'c'} = $b{'a'}[2];
 #$a = $b{'a'};
 EOT
 
@@ -130,15 +156,15 @@ $WANT = <<'EOT';
 #$a = [
 #  1,
 #  {
+#    'c' => [],
 #    'a' => [],
-#    'b' => {},
-#    'c' => []
+#    'b' => {}
 #  },
 #  []
 #];
+#$a->[1]{'c'} = \@c;
 #$a->[1]{'a'} = $a;
 #$a->[1]{'b'} = $a->[1];
-#$a->[1]{'c'} = \@c;
 #$a->[2] = \@c;
 #$b = $a->[1];
 EOT
@@ -166,12 +192,12 @@ $WANT = <<'EOT';
 #       1,
 #       #1
 #       {
-#         a => $a,
-#         b => $a->[1],
 #         c => [
 #                #0
 #                'c'
-#              ]
+#              ],
+#         a => $a,
+#         b => $a->[1]
 #       },
 #       #2
 #       $a->[1]{c}
@@ -191,11 +217,11 @@ $WANT = <<'EOT';
 #$VAR1 = [
 #  1,
 #  {
-#    'a' => [],
-#    'b' => {},
 #    'c' => [
 #      'c'
-#    ]
+#    ],
+#    'a' => [],
+#    'b' => {}
 #  },
 #  []
 #];
@@ -213,11 +239,11 @@ $WANT = <<'EOT';
 #[
 #  1,
 #  {
-#    a => $VAR1,
-#    b => $VAR1->[1],
 #    c => [
 #      'c'
-#    ]
+#    ],
+#    a => $VAR1,
+#    b => $VAR1->[1]
 #  },
 #  $VAR1->[1]{c}
 #]
@@ -236,11 +262,14 @@ EOT
 ##
 $WANT = <<'EOT';
 #$VAR1 = {
+#  "reftest" => \\1,
 #  "abc\0'\efg" => "mno\0"
 #};
 EOT
 
-$foo = { "abc\000\'\efg" => "mno\000" };
+$foo = { "abc\000\'\efg" => "mno\000",
+         "reftest" => \\1,
+       };
 {
   local $Data::Dumper::Useqq = 1;
   TEST q(Dumper($foo));
@@ -248,6 +277,7 @@ $foo = { "abc\000\'\efg" => "mno\000" };
 
   $WANT = <<"EOT";
 #\$VAR1 = {
+#  'reftest' => \\\\1,
 #  'abc\0\\'\efg' => 'mno\0'
 #};
 EOT
@@ -266,7 +296,7 @@ EOT
   package main;
   use Data::Dumper;
   $foo = 5;
-  @foo = (10,\*foo);
+  @foo = (-10,\*foo);
   %foo = (a=>1,b=>\$foo,c=>\@foo);
   $foo{d} = \%foo;
   $foo[2] = \%foo;
@@ -278,20 +308,20 @@ EOT
 #*::foo = \5;
 #*::foo = [
 #           #0
-#           10,
+#           -10,
 #           #1
-#           '',
+#           do{my $o},
 #           #2
 #           {
-#             'a' => 1,
-#             'b' => '',
 #             'c' => [],
+#             'a' => 1,
+#             'b' => do{my $o},
 #             'd' => {}
 #           }
 #         ];
 #*::foo{ARRAY}->[1] = $foo;
-#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
 #*::foo = *::foo{ARRAY}->[2];
 #@bar = @{*::foo{ARRAY}};
@@ -309,18 +339,18 @@ EOT
 #$foo = \*::foo;
 #*::foo = \5;
 #*::foo = [
-#  10,
-#  '',
+#  -10,
+#  do{my $o},
 #  {
-#    'a' => 1,
-#    'b' => '',
 #    'c' => [],
+#    'a' => 1,
+#    'b' => do{my $o},
 #    'd' => {}
 #  }
 #];
 #*::foo{ARRAY}->[1] = $foo;
-#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
 #*::foo = *::foo{ARRAY}->[2];
 #$bar = *::foo{ARRAY};
@@ -335,20 +365,20 @@ EOT
 ##
   $WANT = <<'EOT';
 #@bar = (
-#  10,
+#  -10,
 #  \*::foo,
 #  {}
 #);
 #*::foo = \5;
 #*::foo = \@bar;
 #*::foo = {
-#  'a' => 1,
-#  'b' => '',
 #  'c' => [],
+#  'a' => 1,
+#  'b' => do{my $o},
 #  'd' => {}
 #};
-#*::foo{HASH}->{'b'} = *::foo{SCALAR};
 #*::foo{HASH}->{'c'} = \@bar;
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
 #*::foo{HASH}->{'d'} = *::foo{HASH};
 #$bar[2] = *::foo{HASH};
 #%baz = %{*::foo{HASH}};
@@ -362,20 +392,20 @@ EOT
 ##
   $WANT = <<'EOT';
 #$bar = [
-#  10,
+#  -10,
 #  \*::foo,
 #  {}
 #];
 #*::foo = \5;
 #*::foo = $bar;
 #*::foo = {
-#  'a' => 1,
-#  'b' => '',
 #  'c' => [],
+#  'a' => 1,
+#  'b' => do{my $o},
 #  'd' => {}
 #};
-#*::foo{HASH}->{'b'} = *::foo{SCALAR};
 #*::foo{HASH}->{'c'} = $bar;
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
 #*::foo{HASH}->{'d'} = *::foo{HASH};
 #$bar->[2] = *::foo{HASH};
 #$baz = *::foo{HASH};
@@ -390,12 +420,12 @@ EOT
   $WANT = <<'EOT';
 #$foo = \*::foo;
 #@bar = (
-#  10,
+#  -10,
 #  $foo,
 #  {
+#    c => \@bar,
 #    a => 1,
 #    b => \5,
-#    c => \@bar,
 #    d => $bar[2]
 #  }
 #);
@@ -412,12 +442,12 @@ EOT
   $WANT = <<'EOT';
 #$foo = \*::foo;
 #$bar = [
-#  10,
+#  -10,
 #  $foo,
 #  {
+#    c => $bar,
 #    a => 1,
 #    b => \5,
-#    c => $bar,
 #    d => $bar->[2]
 #  }
 #];
@@ -446,8 +476,8 @@ EOT
 ##
   $WANT = <<'EOT';
 #%kennels = (
-#  First => \'Fido',
-#  Second => \'Wags'
+#  Second => \'Wags',
+#  First => \'Fido'
 #);
 #@dogs = (
 #  ${$kennels{First}},
@@ -485,8 +515,8 @@ EOT
 ##
   $WANT = <<'EOT';
 #%kennels = (
-#  First => \'Fido',
-#  Second => \'Wags'
+#  Second => \'Wags',
+#  First => \'Fido'
 #);
 #@dogs = (
 #  ${$kennels{First}},
@@ -509,8 +539,8 @@ EOT
 #  'Fido',
 #  'Wags',
 #  {
-#    First => \$dogs[0],
-#    Second => \$dogs[1]
+#    Second => \$dogs[1],
+#    First => \$dogs[0]
 #  }
 #);
 #%kennels = %{$dogs[2]};
@@ -544,13 +574,13 @@ EOT
 #  'Fido',
 #  'Wags',
 #  {
-#    First => \'Fido',
-#    Second => \'Wags'
+#    Second => \'Wags',
+#    First => \'Fido'
 #  }
 #);
 #%kennels = (
-#  First => \'Fido',
-#  Second => \'Wags'
+#  Second => \'Wags',
+#  First => \'Fido'
 #);
 EOT
 
@@ -619,7 +649,7 @@ TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
   $WANT = <<'EOT';
 #@a = (
 #  undef,
-#  ''
+#  do{my $o}
 #);
 #$a[1] = \$a[0];
 EOT
@@ -656,7 +686,7 @@ TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
 #  {
 #    a => \[
 #        {
-#          c => ''
+#          c => do{my $o}
 #        },
 #        {
 #          d => \[]
@@ -702,3 +732,79 @@ TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
        if $XS;
 }
+
+{
+    $f = "pearl";
+    $e = [        $f ];
+    $d = { 'e' => $e };
+    $c = [        $d ];
+    $b = { 'c' => $c };
+    $a = { 'b' => $b };
+
+############# 163
+##
+  $WANT = <<'EOT';
+#$a = {
+#  b => {
+#    c => [
+#      {
+#        e => 'ARRAY(0xdeadbeef)'
+#      }
+#    ]
+#  }
+#};
+#$b = $a->{b};
+#$c = $a->{b}{c};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
+       if $XS;
+
+############# 169
+##
+  $WANT = <<'EOT';
+#$a = {
+#  b => 'HASH(0xdeadbeef)'
+#};
+#$b = $a->{b};
+#$c = [
+#  'HASH(0xdeadbeef)'
+#];
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
+       if $XS;
+}
+
+{
+    $a = \$a;
+    $b = [$a];
+
+############# 175
+##
+  $WANT = <<'EOT';
+#$b = [
+#  \$b->[0]
+#];
+EOT
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
+       if $XS;
+
+############# 181
+##
+  $WANT = <<'EOT';
+#$b = [
+#  \do{my $o}
+#];
+#${$b->[0]} = $b->[0];
+EOT
+
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
+       if $XS;
+}