The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# This code, as is the case with much of the other test code is
# modified in minor ways from the original test case created
# by Kevin Ryde.

# Kevin Ryde: MyObject has data hidden away from Test::Weaken's normal
# traversals, in this case separate %data and %moredata hashes.  This is
# like an "inside-out" object, and as is sometimes done for extra data
# in a subclass.  It also resembles case where data is kept only in C
# code structures.

package MyObject;
use strict;
use warnings;

use Test::More tests => 3;
use English qw( -no_match_vars );
use Fatal qw(open close);
use Test::Weaken;
use Data::Dumper;

use lib 't/lib';
use Test::Weaken::Test;

my %data;
my %moredata;

sub construct_data {
    return ['extra data'];
}

sub construct_more_data {
    return [ 'more extra data', ['with a sub-array too'] ];
}

sub new {
    my ($class) = @_;
    my $scalar  = 42;
    my $self    = \$scalar;
    $data{ $self + 0 }     = construct_data;
    $moredata{ $self + 0 } = construct_more_data;
    return bless $self, $class;
} ## end sub new

sub DESTROY {
    my ($self) = @_;
    delete $data{ $self + 0 };
    delete $moredata{ $self + 0 };
    return;
} ## end sub DESTROY

sub data {
    my ($self) = @_;
    return $data{ $self + 0 };
}

sub moredata {
    my ($self) = @_;
    return $moredata{ $self + 0 };
}

## use Marpa::Test::Display contents sub snippet

sub contents {
    my ($probe) = @_;
    return unless Scalar::Util::reftype $probe eq 'REF';
    my $thing = ${$probe};
    return unless Scalar::Util::blessed($thing);
    return unless $thing->isa('MyObject');
    return ( $thing->data, $thing->moredata );
} ## end sub MyObject::contents

## no Marpa::Test::Display

package main;

{

## use Marpa::Test::Display contents named arg snippet

    my $tester = Test::Weaken::leaks(
        {   constructor => sub { return MyObject->new },
            contents    => \&MyObject::contents
        }
    );

## no Marpa::Test::Display

    Test::More::is( $tester, undef, 'good weaken of MyObject' );
}

# Leaky Data Detection
{
    my $leak;
    my $self_index;
    my $tester = Test::Weaken::leaks(
        {   constructor => sub {
                my $obj = MyObject->new;
                $self_index = $obj + 0;
                $leak       = $obj->data;
                return $obj;
            },
            contents => \&MyObject::contents
        }
    );
    my $test_name = 'leaky data detection';
    if ( not $tester ) {
        Test::More::fail($test_name);
    }
    else {
        Test::More::is_deeply( $leak, MyObject->construct_data, $test_name );
    }
}

# More Leaky Data Detection
{
    my $leak;
    my $self_index;
    my $tester = Test::Weaken::leaks(
        {   constructor => sub {
                my $obj = MyObject->new;
                $self_index = $obj + 0;
                $leak       = $obj->moredata;
                return $obj;
            },
            contents => \&MyObject::contents
        }
    );
    my $test_name = q{more leaky data detection};
    if ( not $tester ) {
        Test::More::fail($test_name);
    }
    else {
        Test::More::is_deeply( $leak, MyObject->construct_more_data,
            $test_name );
    }
}

exit 0;