The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
use strict;
use Test::Requires qw(Moose);
use Test::More;
use Test::Exception;

use Test::Mouse;

my $person_build      = 0;
my $person_demolish   = 0;
my $myperson_build    = 0;
my $myperson_demolish = 0;
BEGIN{
    package Person;
    use Moose;

    has name => (is => 'rw');
    has age  => (is => 'rw');

    sub BUILD    { $person_build++ }
    sub DEMOLISH { $person_demolish++ }

    __PACKAGE__->meta->make_immutable();
}

{
    package MyPerson;
    use Mouse;
    use MouseX::Foreign qw(Person);

    has handle_name => (
        is => 'rw',
        isa => 'Str',
    );

    sub BUILD { $myperson_build++ }
    sub DEMOLISH { $myperson_demolish++ }
}

with_immutable {
    my $p = MyPerson->new(name => 'Goro Fuji', age => 27, handle_name => 'gfx');

    isa_ok $p, 'MyPerson';
    isa_ok $p, 'Person';

    is $p->name,        'Goro Fuji', 'from the base class';
    is $p->age,          27,         'from the base class';
    is $p->handle_name, 'gfx',       'from the derived class';

} qw(MyPerson);

is $person_build,      2, "the base class's BUILD is colled";
is $person_demolish,   2, "the base class's DEMOLISH is called";
is $myperson_build,    2, 'my BUILD is called';
is $myperson_demolish, 2, 'my DEMOLISH is called';
done_testing;