#!./perl -w
# t/purity_deepcopy_maxdepth.t - Test Purity(), Deepcopy(),
# Maxdepth() and recursive structures

BEGIN {
    if ($ENV{PERL_CORE}){
        require Config; import Config;
        no warnings 'once';
        if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
            print "1..0 # Skip: Data::Dumper was not built\n";
            exit 0;
        }
    }
}

use strict;

use Data::Dumper;
use Test::More tests => 24;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );

my ($a, $b, $c, @d);
my ($d, $e, $f);

note("\$Data::Dumper::Purity and Purity()");

{
    my ($obj, %dumps, $purity);

    # Adapted from example in Dumper.pm POD:
    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Purity = undef");
    local $Data::Dumper::Useperl = 1;
    $purity = undef;
    local $Data::Dumper::Purity = $purity;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'ddpundef'} = _dumptostr($obj);

    $purity = 0;
    local $Data::Dumper::Purity = $purity;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'ddpzero'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'ddpundef'},
        "No previous Purity setting equivalent to \$Data::Dumper::Purity = undef");

    is($dumps{'noprev'}, $dumps{'ddpzero'},
        "No previous Purity setting equivalent to \$Data::Dumper::Purity = 0");
}

{
    my ($obj, %dumps, $purity);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $purity = 0;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Purity($purity);
    $dumps{'objzero'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'objzero'},
        "No previous Purity setting equivalent to Purity(0)");

    $purity = undef;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Purity($purity);
   $dumps{'objundef'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'objundef'},
        "No previous Purity setting equivalent to Purity(undef)");
}

{
    my ($obj, %dumps, $purity);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $purity = 1;
    local $Data::Dumper::Purity = $purity;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'ddpone'} = _dumptostr($obj);

    isnt($dumps{'noprev'}, $dumps{'ddpone'},
        "No previous Purity setting different from \$Data::Dumper::Purity = 1");
}

{
    my ($obj, %dumps, $purity);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $purity = 1;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Purity(1);
    $dumps{'objone'} = _dumptostr($obj);

    isnt($dumps{'noprev'}, $dumps{'objone'},
        "No previous Purity setting different from Purity(0)");
}

{
    my ($obj, %dumps, $purity);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $purity = 1;
    local $Data::Dumper::Purity = $purity;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'ddpone'} = _dumptostr($obj);
    local $Data::Dumper::Purity = undef;

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Purity(1);
    $dumps{'objone'} = _dumptostr($obj);

    is($dumps{'ddpone'}, $dumps{'objone'},
        "\$Data::Dumper::Purity = 1 and Purity(1) are equivalent");
}

note("\$Data::Dumper::Deepcopy and Deepcopy()");

{
    my ($obj, %dumps, $deepcopy);

    # Adapted from example in Dumper.pm POD:
    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $deepcopy = undef;
    local $Data::Dumper::Deepcopy = $deepcopy;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'dddundef'} = _dumptostr($obj);

    $deepcopy = 0;
    local $Data::Dumper::Deepcopy = $deepcopy;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'dddzero'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'dddundef'},
        "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = undef");

    is($dumps{'noprev'}, $dumps{'dddzero'},
        "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = 0");
}

{
    my ($obj, %dumps, $deepcopy);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $deepcopy = 0;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Deepcopy($deepcopy);
    $dumps{'objzero'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'objzero'},
        "No previous Deepcopy setting equivalent to Deepcopy(0)");

    $deepcopy = undef;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Deepcopy($deepcopy);
    $dumps{'objundef'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'objundef'},
        "No previous Deepcopy setting equivalent to Deepcopy(undef)");
}

{
    my ($obj, %dumps, $deepcopy);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $deepcopy = 1;
    local $Data::Dumper::Deepcopy = $deepcopy;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'dddone'} = _dumptostr($obj);

    isnt($dumps{'noprev'}, $dumps{'dddone'},
        "No previous Deepcopy setting different from \$Data::Dumper::Deepcopy = 1");
}

{
    my ($obj, %dumps, $deepcopy);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $deepcopy = 1;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Deepcopy(1);
    $dumps{'objone'} = _dumptostr($obj);

    isnt($dumps{'noprev'}, $dumps{'objone'},
        "No previous Deepcopy setting different from Deepcopy(0)");
}

{
    my ($obj, %dumps, $deepcopy);

    @d = ('c');
    $c = \@d;
    $b = {};
    $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];

    $deepcopy = 1;
    local $Data::Dumper::Deepcopy = $deepcopy;
    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $dumps{'dddone'} = _dumptostr($obj);
    local $Data::Dumper::Deepcopy = undef;

    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
    $obj->Deepcopy(1);
    $dumps{'objone'} = _dumptostr($obj);

    is($dumps{'dddone'}, $dumps{'objone'},
        "\$Data::Dumper::Deepcopy = 1 and Deepcopy(1) are equivalent");
}

note("\$Data::Dumper::Maxdepth and Maxdepth()");

{
    # Adapted from Dumper.pm POD

    my ($obj, %dumps, $maxdepth);

    $a = "pearl";
    $b = [ $a ];
    $c = { 'b' => $b };
    $d = [ $c ];
    $e = { 'd' => $d };
    $f = { 'e' => $e };

    note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef");
    local $Data::Dumper::Useperl = 1;

    $obj = Data::Dumper->new([$f], [qw(f)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $Data::Dumper::Maxdepth = undef;
    $obj = Data::Dumper->new([$f], [qw(f)]);
    $dumps{'ddmundef'} = _dumptostr($obj);

    $maxdepth = 3;
    local $Data::Dumper::Maxdepth = $maxdepth;
    $obj = Data::Dumper->new([$f], [qw(f)]);
    $dumps{'ddm'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'ddmundef'},
        "No previous Maxdepth setting equivalent to \$Data::Dumper::Maxdepth = undef");

    like($dumps{'noprev'}, qr/$a/s,
        "Without Maxdepth, got output from deepest level");

    isnt($dumps{'noprev'}, $dumps{'ddm'},
        "No previous Maxdepth setting differs from setting a shallow Maxdepth");

    unlike($dumps{'ddm'}, qr/$a/s,
        "With Maxdepth, did not get output from deepest level");
}

{
    # Adapted from Dumper.pm POD

    my ($obj, %dumps, $maxdepth);

    $a = "pearl";
    $b = [ $a ];
    $c = { 'b' => $b };
    $d = [ $c ];
    $e = { 'd' => $d };
    $f = { 'e' => $e };

    note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef");
    local $Data::Dumper::Useperl = 1;

    $obj = Data::Dumper->new([$f], [qw(f)]);
    $dumps{'noprev'} = _dumptostr($obj);

    $obj = Data::Dumper->new([$f], [qw(f)]);
    $obj->Maxdepth();
    $dumps{'maxdepthempty'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'maxdepthempty'},
        "No previous Maxdepth setting equivalent to Maxdepth() with no argument");

    $obj = Data::Dumper->new([$f], [qw(f)]);
    $obj->Maxdepth(undef);
    $dumps{'maxdepthundef'} = _dumptostr($obj);

    is($dumps{'noprev'}, $dumps{'maxdepthundef'},
        "No previous Maxdepth setting equivalent to Maxdepth(undef)");

    $maxdepth = 3;
    $obj = Data::Dumper->new([$f], [qw(f)]);
    $obj->Maxdepth($maxdepth);
    $dumps{'maxdepthset'} = _dumptostr($obj);

    isnt($dumps{'noprev'}, $dumps{'maxdepthset'},
        "No previous Maxdepth setting differs from Maxdepth() with shallow depth");

    local $Data::Dumper::Maxdepth = 3;
    $obj = Data::Dumper->new([$f], [qw(f)]);
    $dumps{'ddmset'} = _dumptostr($obj);

    is($dumps{'maxdepthset'}, $dumps{'ddmset'},
        "Maxdepth set and \$Data::Dumper::Maxdepth are equivalent");
}

{
    my ($obj, %dumps);

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = $_[0] };

    local $Data::Dumper::Deparse = 0;
    local $Data::Dumper::Purity  = 1;
    local $Data::Dumper::Useperl = 1;
    sub hello { print "Hello world\n"; }
    $obj = Data::Dumper->new( [ \&hello ] );
    $dumps{'ddsksub'} = _dumptostr($obj);
    like($warning, qr/^Encountered CODE ref, using dummy placeholder/,
        "Got expected warning: dummy placeholder under Purity = 1");
}

{
    my ($obj, %dumps);

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = $_[0] };

    local $Data::Dumper::Deparse = 0;
    local $Data::Dumper::Useperl = 1;
    sub jello { print "Jello world\n"; }
    $obj = Data::Dumper->new( [ \&hello ] );
    $dumps{'ddsksub'} = _dumptostr($obj);
    ok(! $warning, "Encountered CODE ref, but no Purity, hence no warning");
}