Implement strict constructors, which will warn unkown constructor arguments

[gitmo/Mouse.git] / t / 050_metaclasses / failing / 030_metarole_combination.t

use strict;
use warnings;
use Test::More;

our @applications;

{
    package CustomApplication;
    use Mouse::Role;

    after apply_methods => sub {
        my ( $self, $role, $other ) = @_;
        $self->apply_custom( $role, $other );
    };

    sub apply_custom {
        shift;
        push @applications, [@_];
    }
}

{
    package CustomApplication::ToClass;
    use Mouse::Role;

    with 'CustomApplication';
}

{
    package CustomApplication::ToRole;
    use Mouse::Role;

    with 'CustomApplication';
}

{
    package CustomApplication::ToInstance;
    use Mouse::Role;

    with 'CustomApplication';
}

{
    package CustomApplication::Composite;
    use Mouse::Role;

    with 'CustomApplication';

    around apply_custom => sub {
        my ( $next, $self, $composite, $other ) = @_;
        for my $role ( @{ $composite->get_roles } ) {
            $self->$next( $role, $other );
        }
    };
}

{
    package CustomApplication::Composite::ToClass;
    use Mouse::Role;

    with 'CustomApplication::Composite';
}

{
    package CustomApplication::Composite::ToRole;
    use Mouse::Role;

    with 'CustomApplication::Composite';
}

{
    package CustomApplication::Composite::ToInstance;
    use Mouse::Role;

    with 'CustomApplication::Composite';
}

{
    package Role::Composite;
    use Mouse::Role;

    around apply_params => sub {
        my ( $next, $self, @args ) = @_;
        return Mouse::Util::MetaRole::apply_metaclass_roles(
            for_class => $self->$next(@args),
            application_to_class_class_roles =>
                ['CustomApplication::Composite::ToClass'],
            application_to_role_class_roles =>
                ['CustomApplication::Composite::ToRole'],
            application_to_instance_class_roles =>
                ['CustomApplication::Composite::ToInstance'],
        );
    };
}

{
    package Role::WithCustomApplication;
    use Mouse::Role;

    has '+composition_class_roles' => (
        default => ['Role::Composite'],
    );
}

{
    package CustomRole;
    Mouse::Exporter->setup_import_methods(
        also => 'Mouse::Role',
    );

    sub init_meta {
        my ( $self, %options ) = @_;
        return Mouse::Util::MetaRole::apply_metaclass_roles(
            for_class       => Mouse::Role->init_meta(%options),
            metaclass_roles => ['Role::WithCustomApplication'],
            application_to_class_class_roles =>
                ['CustomApplication::ToClass'],
            application_to_role_class_roles => ['CustomApplication::ToRole'],
            application_to_instance_class_roles =>
                ['CustomApplication::ToInstance'],
        );
    }
}

{
    package My::Role::Normal;
    use Mouse::Role;
}

{
    package My::Role::Special;
    CustomRole->import;
}

ok( My::Role::Normal->meta->isa('Mouse::Meta::Role'), "sanity check" );
ok( My::Role::Special->meta->isa('Mouse::Meta::Role'),
    "using custom application roles does not change the role metaobject's class"
);
ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'),
    "the role's metaobject has custom applications" );
is_deeply( My::Role::Special->meta->composition_class_roles,
    ['Role::Composite'],
    "the role knows about the specified composition class" );

{
    package Foo;
    use Mouse;

    local @applications;
    with 'My::Role::Special';

    ::is( @applications, 1, 'one role application' );
    ::is( $applications[0]->[0]->name, 'My::Role::Special',
        "the application's first role was My::Role::Special'" );
    ::is( $applications[0]->[1]->name, 'Foo',
        "the application provided an additional role" );
}

{
    package Bar;
    use Mouse::Role;

    local @applications;
    with 'My::Role::Special';

    ::is( @applications,               1 );
    ::is( $applications[0]->[0]->name, 'My::Role::Special' );
    ::is( $applications[0]->[1]->name, 'Bar' );
}

{
    package Baz;
    use Mouse;

    my $i = Baz->new;
    local @applications;
    My::Role::Special->meta->apply($i);

    ::is( @applications,               1 );
    ::is( $applications[0]->[0]->name, 'My::Role::Special' );
    ::ok( $applications[0]->[1]->is_anon_class );
    ::ok( $applications[0]->[1]->name->isa('Baz') );
}

{
    package Corge;
    use Mouse;

    local @applications;
    with 'My::Role::Normal', 'My::Role::Special';

    ::is( @applications,               2 );
    ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
    ::is( $applications[0]->[1]->name, 'Corge' );
    ::is( $applications[1]->[0]->name, 'My::Role::Special' );
    ::is( $applications[1]->[1]->name, 'Corge' );
}

{
    package Thud;
    use Mouse::Role;

    local @applications;
    with 'My::Role::Normal', 'My::Role::Special';

    ::is( @applications,               2 );
    ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
    ::is( $applications[0]->[1]->name, 'Thud' );
    ::is( $applications[1]->[0]->name, 'My::Role::Special' );
    ::is( $applications[1]->[1]->name, 'Thud' );
}

{
    package Garply;
    use Mouse;

    my $i = Garply->new;
    local @applications;
    Mouse::Meta::Role->combine(
        [ 'My::Role::Normal'  => undef ],
        [ 'My::Role::Special' => undef ],
    )->apply($i);

    ::is( @applications,               2 );
    ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
    ::ok( $applications[0]->[1]->is_anon_class );
    ::ok( $applications[0]->[1]->name->isa('Garply') );
    ::is( $applications[1]->[0]->name, 'My::Role::Special' );
    ::ok( $applications[1]->[1]->is_anon_class );
    ::ok( $applications[1]->[1]->name->isa('Garply') );
}

done_testing;