use strict;
use warnings;
use Test::More;
our @applications;
{
package CustomApplication;
use Moose::Role;
after apply_methods => sub {
my ( $self, $role, $other ) = @_;
$self->apply_custom( $role, $other );
};
sub apply_custom {
shift;
push @applications, [@_];
}
}
{
package CustomApplication::ToClass;
use Moose::Role;
with 'CustomApplication';
}
{
package CustomApplication::ToRole;
use Moose::Role;
with 'CustomApplication';
}
{
package CustomApplication::ToInstance;
use Moose::Role;
with 'CustomApplication';
}
{
package CustomApplication::Composite;
use Moose::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 Moose::Role;
with 'CustomApplication::Composite';
}
{
package CustomApplication::Composite::ToRole;
use Moose::Role;
with 'CustomApplication::Composite';
}
{
package CustomApplication::Composite::ToInstance;
use Moose::Role;
with 'CustomApplication::Composite';
}
{
package Role::Composite;
use Moose::Role;
around apply_params => sub {
my ( $next, $self, @args ) = @_;
return Moose::Util::MetaRole::apply_metaroles(
for => $self->$next(@args),
role_metaroles => {
application_to_class =>
['CustomApplication::Composite::ToClass'],
application_to_role =>
['CustomApplication::Composite::ToRole'],
application_to_instance =>
['CustomApplication::Composite::ToInstance'],
},
);
};
}
{
package Role::WithCustomApplication;
use Moose::Role;
around composition_class_roles => sub {
my ($orig, $self) = @_;
return $self->$orig, 'Role::Composite';
};
}
{
package CustomRole;
Moose::Exporter->setup_import_methods(
also => 'Moose::Role',
);
sub init_meta {
my ( $self, %options ) = @_;
return Moose::Util::MetaRole::apply_metaroles(
for => Moose::Role->init_meta(%options),
role_metaroles => {
role => ['Role::WithCustomApplication'],
application_to_class =>
['CustomApplication::ToClass'],
application_to_role => ['CustomApplication::ToRole'],
application_to_instance =>
['CustomApplication::ToInstance'],
},
);
}
}
{
package My::Role::Normal;
use Moose::Role;
}
{
package My::Role::Special;
CustomRole->import;
}
ok( My::Role::Normal->meta->isa('Moose::Meta::Role'), "sanity check" );
ok( My::Role::Special->meta->isa('Moose::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 Moose;
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 Moose::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 Moose;
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 Moose;
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 Moose::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 Moose;
my $i = Garply->new;
local @applications;
Moose::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;