The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use Test::Moose;
use Test::Fatal;

sub check_meta_sanity {
    my ($meta, $class) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    isa_ok($meta, 'Moose::Meta::Class');
    is($meta->name, $class);
    ok($meta->has_method('foo'));
    isa_ok($meta->get_method('foo'), 'Moose::Meta::Method');
    ok($meta->has_attribute('bar'));
    isa_ok($meta->get_attribute('bar'), 'Moose::Meta::Attribute');

    if ( $meta->name eq 'Foo' ) {
        ok($meta->does_role('Role1'), 'does Role1');
        ok($meta->does_role('Role2'), 'does Role2');

        is_deeply(
            [
                map { [ $_->role->name, $_->class->name ] }
                    sort { $a->role->name cmp $b->role->name }
                    $meta->role_applications
            ],
            [
                [ 'Role1|Role2', 'Foo' ],
            ],
            'role applications for Role1 and Role2'
        );
    }
}

{
    package Role1;
    use Moose::Role;
}

{
    package Role2;
    use Moose::Role;
}

{
    package Foo;
    use Moose;
    sub foo {}
    with 'Role1', 'Role2';
    has bar => (is => 'ro');
}

check_meta_sanity(Foo->meta, 'Foo');

Moose::Meta::Class->reinitialize('Foo');
check_meta_sanity(Foo->meta, 'Foo');

{
    package Foo::Role::Method;
    use Moose::Role;

    has foo => (is => 'rw');
}

{
    package Foo::Role::Attribute;
    use Moose::Role;
    has oof => (is => 'rw');
}

Moose::Util::MetaRole::apply_metaroles(
    for => 'Foo',
    class_metaroles => {
        method    => ['Foo::Role::Method'],
        attribute => ['Foo::Role::Attribute'],
    },
);
check_meta_sanity(Foo->meta, 'Foo');
does_ok(Foo->meta->get_method('foo'), 'Foo::Role::Method');
does_ok(Foo->meta->get_attribute('bar'), 'Foo::Role::Attribute');

Moose::Meta::Class->reinitialize('Foo');
check_meta_sanity(Foo->meta, 'Foo');
does_ok(Foo->meta->get_method('foo'), 'Foo::Role::Method');
does_ok(Foo->meta->get_attribute('bar'), 'Foo::Role::Attribute');

Foo->meta->get_method('foo')->foo('TEST');
Foo->meta->get_attribute('bar')->oof('TSET');
is(Foo->meta->get_method('foo')->foo, 'TEST');
is(Foo->meta->get_attribute('bar')->oof, 'TSET');
Moose::Meta::Class->reinitialize('Foo');
check_meta_sanity(Foo->meta, 'Foo');
is(Foo->meta->get_method('foo')->foo, 'TEST');
is(Foo->meta->get_attribute('bar')->oof, 'TSET');

{
    package Bar::Role::Method;
    use Moose::Role;
}

{
    package Bar::Role::Attribute;
    use Moose::Role;
}

{
    package Bar;
    use Moose;
    Moose::Util::MetaRole::apply_metaroles(
        for => 'Bar',
        class_metaroles => {
            method    => ['Bar::Role::Method'],
            attribute => ['Bar::Role::Attribute'],
        },
    );
    sub foo {}
    has bar => (is => 'ro');
}

check_meta_sanity(Bar->meta, 'Bar');
does_ok(Bar->meta->get_method('foo'), 'Bar::Role::Method');
does_ok(Bar->meta->get_attribute('bar'), 'Bar::Role::Attribute');

Moose::Meta::Class->reinitialize('Bar');
check_meta_sanity(Bar->meta, 'Bar');
does_ok(Bar->meta->get_method('foo'), 'Bar::Role::Method');
does_ok(Bar->meta->get_attribute('bar'), 'Bar::Role::Attribute');
ok(!Moose::Util::does_role(Bar->meta->get_method('foo'), 'Foo::Role::Method'));
ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Foo::Role::Attribute'));

Moose::Util::MetaRole::apply_metaroles(
    for => 'Bar',
    class_metaroles => {
        method    => ['Foo::Role::Method'],
        attribute => ['Foo::Role::Attribute'],
    },
);
check_meta_sanity(Bar->meta, 'Bar');
does_ok(Bar->meta->get_method('foo'), 'Bar::Role::Method');
does_ok(Bar->meta->get_attribute('bar'), 'Bar::Role::Attribute');
does_ok(Bar->meta->get_method('foo'), 'Foo::Role::Method');
does_ok(Bar->meta->get_attribute('bar'), 'Foo::Role::Attribute');

{
    package Bar::Meta::Method;
    use Moose;
    BEGIN { extends 'Moose::Meta::Method' };
}

{
    package Bar::Meta::Attribute;
    use Moose;
    BEGIN { extends 'Moose::Meta::Attribute' };
}

like( exception {
    Moose::Meta::Class->reinitialize(
        'Bar',
        method_metaclass    => 'Bar::Meta::Method',
        attribute_metaclass => 'Bar::Meta::Attribute',
    );
}, qr/\QAttribute (class_name) is required/ );

{
    package Baz::Meta::Class;
    use Moose;
    BEGIN { extends 'Moose::Meta::Class' };

    sub initialize {
        my $self = shift;
        return $self->SUPER::initialize(
            @_,
            method_metaclass    => 'Bar::Meta::Method',
            attribute_metaclass => 'Bar::Meta::Attribute'
        );
    }
}

{
    package Baz;
    use Moose -metaclass => 'Baz::Meta::Class';
    sub foo {}
    has bar => (is => 'ro');
}

check_meta_sanity(Baz->meta, 'Baz');
isa_ok(Baz->meta->get_method('foo'), 'Bar::Meta::Method');
isa_ok(Baz->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
Moose::Meta::Class->reinitialize('Baz');
check_meta_sanity(Baz->meta, 'Baz');
isa_ok(Baz->meta->get_method('foo'), 'Bar::Meta::Method');
isa_ok(Baz->meta->get_attribute('bar'), 'Bar::Meta::Attribute');

Moose::Util::MetaRole::apply_metaroles(
    for => 'Baz',
    class_metaroles => {
        method    => ['Foo::Role::Method'],
        attribute => ['Foo::Role::Attribute'],
    },
);
check_meta_sanity(Baz->meta, 'Baz');
isa_ok(Baz->meta->get_method('foo'), 'Bar::Meta::Method');
isa_ok(Baz->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
does_ok(Baz->meta->get_method('foo'), 'Foo::Role::Method');
does_ok(Baz->meta->get_attribute('bar'), 'Foo::Role::Attribute');

{
    package Baz::Meta::Method;
    use Moose;
    extends 'Moose::Meta::Method';
}

{
    package Baz::Meta::Attribute;
    use Moose;
    extends 'Moose::Meta::Attribute';
}

like( exception {
    Moose::Meta::Class->reinitialize(
        'Baz',
        method_metaclass    => 'Baz::Meta::Method',
        attribute_metaclass => 'Baz::Meta::Attribute',
    );
}, qr/\QAttribute (class_name) is required/ );

{
    package Quux;
    use Moose;
    sub foo { }
    before foo => sub { };
    has bar => (is => 'ro');
    sub DEMOLISH { }
    __PACKAGE__->meta->make_immutable;
}

ok(Quux->meta->has_method('new'));
isa_ok(Quux->meta->get_method('new'), 'Moose::Meta::Method::Constructor');
ok(Quux->meta->has_method('meta'));
isa_ok(Quux->meta->get_method('meta'), 'Moose::Meta::Method::Meta');
ok(Quux->meta->has_method('foo'));
isa_ok(Quux->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
ok(Quux->meta->has_method('bar'));
isa_ok(Quux->meta->get_method('bar'), 'Moose::Meta::Method::Accessor');
ok(Quux->meta->has_method('DESTROY'));
isa_ok(Quux->meta->get_method('DESTROY'), 'Moose::Meta::Method::Destructor');
ok(Quux->meta->has_method('DEMOLISH'));
isa_ok(Quux->meta->get_method('DEMOLISH'), 'Moose::Meta::Method');

Quux->meta->make_mutable;
Moose::Meta::Class->reinitialize('Quux');
Quux->meta->make_immutable;

ok(Quux->meta->has_method('new'));
isa_ok(Quux->meta->get_method('new'), 'Moose::Meta::Method::Constructor');
ok(Quux->meta->has_method('meta'));
isa_ok(Quux->meta->get_method('meta'), 'Moose::Meta::Method::Meta');
ok(Quux->meta->has_method('foo'));
isa_ok(Quux->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
ok(Quux->meta->has_method('bar'));
isa_ok(Quux->meta->get_method('bar'), 'Moose::Meta::Method::Accessor');
ok(Quux->meta->has_method('DESTROY'));
isa_ok(Quux->meta->get_method('DESTROY'), 'Moose::Meta::Method::Destructor');
ok(Quux->meta->has_method('DEMOLISH'));
isa_ok(Quux->meta->get_method('DEMOLISH'), 'Moose::Meta::Method');

Quux->meta->make_mutable;
Moose::Util::MetaRole::apply_metaroles(
    for => 'Quux',
    class_metaroles => {
        method    => ['Foo::Role::Method'],
        attribute => ['Foo::Role::Attribute'],
    },
);
Quux->meta->make_immutable;

ok(Quux->meta->has_method('new'));
isa_ok(Quux->meta->get_method('new'), 'Moose::Meta::Method::Constructor');
{ local $TODO = "constructor methods don't get metaroles yet";
does_ok(Quux->meta->get_method('new'), 'Foo::Role::Method');
}
ok(Quux->meta->has_method('meta'));
isa_ok(Quux->meta->get_method('meta'), 'Moose::Meta::Method::Meta');
{ local $TODO = "meta methods don't get metaroles yet";
does_ok(Quux->meta->get_method('meta'), 'Foo::Role::Method');
}
ok(Quux->meta->has_method('foo'));
isa_ok(Quux->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
{ local $TODO = "modified methods don't get metaroles yet";
does_ok(Quux->meta->get_method('foo'), 'Foo::Role::Method');
}
ok(Quux->meta->has_method('bar'));
isa_ok(Quux->meta->get_method('bar'), 'Moose::Meta::Method::Accessor');
{ local $TODO = "accessor methods don't get metaroles yet";
does_ok(Quux->meta->get_method('bar'), 'Foo::Role::Method');
}
ok(Quux->meta->has_method('DESTROY'));
isa_ok(Quux->meta->get_method('DESTROY'), 'Moose::Meta::Method::Destructor');
{ local $TODO = "destructor methods don't get metaroles yet";
does_ok(Quux->meta->get_method('DESTROY'), 'Foo::Role::Method');
}
ok(Quux->meta->has_method('DEMOLISH'));
isa_ok(Quux->meta->get_method('DEMOLISH'), 'Moose::Meta::Method');
does_ok(Quux->meta->get_method('DEMOLISH'), 'Foo::Role::Method');

{
    package Role3;
    use Moose::Role;
    with 'Role1', 'Role2';
}

ok( Role3->meta->does_role('Role1'), 'Role3 does Role1' );
ok( Role3->meta->does_role('Role2'), 'Role3 does Role2' );

Moose::Meta::Role->reinitialize('Role3');

ok( Role3->meta->does_role('Role1'), 'Role3 does Role1 after reinitialize' );
ok( Role3->meta->does_role('Role2'), 'Role3 does Role2 after reinitialize' );

done_testing;