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

use strict;
use Test::More tests => 18;

package A;

sub new {
	my ($pkg,$par) = @_;

	bless {name => $par, constructor => 'A'},$pkg;
}

package Blah;	# B conflicts with the builtin B::
use base qw/A/;

package E;
use strict;

sub new {
	my ($pkg,$par) = @_;

	bless {name => $par, constructor => 'E'},$pkg;
}

use vars qw{$msg};
$msg = '';

sub DESTROY {
	my $self = shift;

	$msg = "E::DESTROY called for ".$self->{name};
}

package D;
use base qw/E/;

package C;
use base qw/Blah D/;

package main;

use strict;

#01
BEGIN {
	use_ok( 'Devel::Leak::Object' );
}

my $foo = C->new('foo');

#02
isa_ok($foo, 'C', "Normal multi inherit");

#03
is($foo->{constructor},'A','Inherits new from A');

undef $foo;

#04
is($E::msg, 'E::DESTROY called for foo', 'Inherited DESTROY method');

$foo = C->new('foo2');
my $bar = D->new('bar');

Devel::Leak::Object::track($bar);

#05
is($bar->{constructor},'E','Inherits new from E');

#06
is($Devel::Leak::Object::OBJECT_COUNT{D}, 1, 'D object count');

undef $bar;

#07
is($Devel::Leak::Object::OBJECT_COUNT{D}, 0, 'D object count decremented');

#08
is($E::msg, 'E::DESTROY called for bar', 'Inherited DESTROY method D::bar');

undef $foo;

#09
is($E::msg, 'E::DESTROY called for foo2', 'Inherited DESTROY method C::foo2');

$foo = C->new('foo3');
$bar = Blah->new('bar');

Devel::Leak::Object::track($bar);

#10
is($bar->{constructor},'A','Inherits new from A');

#11
is($Devel::Leak::Object::OBJECT_COUNT{Blah}, 1, 'Blah object count');

undef $bar;

#12
is($Devel::Leak::Object::OBJECT_COUNT{Blah}, 0, 'Blah object count decremented');

undef $foo;

#13
is($E::msg, 'E::DESTROY called for foo3', 'Inherited DESTROY method C::foo3');


$foo = C->new('foo4');
$bar = C->new('bar');

Devel::Leak::Object::track($bar);

#14
is($bar->{constructor},'A','Inherits new from A');

#15
is($Devel::Leak::Object::OBJECT_COUNT{C}, 1, 'C object count');

undef $bar;

#16
is($Devel::Leak::Object::OBJECT_COUNT{C}, 0, 'C object count decremented');

#17
is($E::msg, 'E::DESTROY called for bar', 'Inherited DESTROY method C::bar');

Devel::Leak::Object::track($foo);

undef $foo;

#18
is($E::msg, 'E::DESTROY called for foo4', 'Inherited DESTROY method C::foo4');