Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
bless.t	1.33 KB	-r--r--r--	2014-12-27 11:48
bless_var_method.t	2.31 KB	-r--r--r--	2014-12-27 11:48
bugs.t	3.61 KB	-r--r--r--	2014-12-27 11:48
deparse.t	2.44 KB	-r--r--r--	2014-12-27 11:48
dumper.t	38.19 KB	-r--r--r--	2014-12-27 11:49
dumpperl.t	3.7 KB	-r--r--r--	2014-12-27 11:48
freezer.t	3.14 KB	-r--r--r--	2014-12-27 11:48
freezer_useperl.t	2.72 KB	-r--r--r--	2014-12-27 11:48
indent.t	3 KB	-r--r--r--	2014-12-27 11:48
misc.t	5.95 KB	-r--r--r--	2014-12-27 11:48
names.t	2.1 KB	-r--r--r--	2014-12-27 11:48
overload.t	610 B	-r--r--r--	2014-12-27 11:48
pair.t	1.87 KB	-r--r--r--	2014-12-27 11:48
perl-74170.t	5.33 KB	-r--r--r--	2014-12-27 11:48
purity_deepcopy_maxdepth.t	10.76 KB	-r--r--r--	2014-12-27 11:48
qr.t	515 B	-r--r--r--	2014-12-27 11:48
quotekeys.t	4.08 KB	-r--r--r--	2014-12-27 11:48
recurse.t	1.64 KB	-r--r--r--	2015-01-10 12:06
seen.t	2.56 KB	-r--r--r--	2014-12-27 11:48
sortkeys.t	5.85 KB	-r--r--r--	2014-12-27 11:48
sparseseen.t	2.46 KB	-r--r--r--	2014-12-27 11:48
terse.t	1.33 KB	-r--r--r--	2014-12-27 11:48
toaster.t	2.43 KB	-r--r--r--	2014-12-27 11:48
values.t	1.06 KB	-r--r--r--	2014-12-27 11:48

Rename

#!./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");
}