+++ /dev/null
-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;