t/050_metaclasses/030_metarole_combination.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 our @applications;
   6
   7 {
   8     package CustomApplication;
   9     use Moose::Role;
  10
  11     after apply_methods => sub {
  12         my ( $self, $role, $other ) = @_;
  13         $self->apply_custom( $role, $other );
  14     };
  15
  16     sub apply_custom {
  17         shift;
  18         push @applications, [@_];
  19     }
  20 }
  21
  22 {
  23     package CustomApplication::ToClass;
  24     use Moose::Role;
  25
  26     with 'CustomApplication';
  27 }
  28
  29 {
  30     package CustomApplication::ToRole;
  31     use Moose::Role;
  32
  33     with 'CustomApplication';
  34 }
  35
  36 {
  37     package CustomApplication::ToInstance;
  38     use Moose::Role;
  39
  40     with 'CustomApplication';
  41 }
  42
  43 {
  44     package CustomApplication::Composite;
  45     use Moose::Role;
  46
  47     with 'CustomApplication';
  48
  49     around apply_custom => sub {
  50         my ( $next, $self, $composite, $other ) = @_;
  51         for my $role ( @{ $composite->get_roles } ) {
  52             $self->$next( $role, $other );
  53         }
  54     };
  55 }
  56
  57 {
  58     package CustomApplication::Composite::ToClass;
  59     use Moose::Role;
  60
  61     with 'CustomApplication::Composite';
  62 }
  63
  64 {
  65     package CustomApplication::Composite::ToRole;
  66     use Moose::Role;
  67
  68     with 'CustomApplication::Composite';
  69 }
  70
  71 {
  72     package CustomApplication::Composite::ToInstance;
  73     use Moose::Role;
  74
  75     with 'CustomApplication::Composite';
  76 }
  77
  78 {
  79     package Role::Composite;
  80     use Moose::Role;
  81
  82     around apply_params => sub {
  83         my ( $next, $self, @args ) = @_;
  84         return Moose::Util::MetaRole::apply_metaclass_roles(
  85             for_class => $self->$next(@args),
  86             application_to_class_class_roles =>
  87                 ['CustomApplication::Composite::ToClass'],
  88             application_to_role_class_roles =>
  89                 ['CustomApplication::Composite::ToRole'],
  90             application_to_instance_class_roles =>
  91                 ['CustomApplication::Composite::ToInstance'],
  92         );
  93     };
  94 }
  95
  96 {
  97     package Role::WithCustomApplication;
  98     use Moose::Role;
  99
 100     around composition_class_roles => sub {
 101         my ($orig, $self) = @_;
 102         return $self->$orig, 'Role::Composite';
 103     };
 104 }
 105
 106 {
 107     package CustomRole;
 108     Moose::Exporter->setup_import_methods(
 109         also => 'Moose::Role',
 110     );
 111
 112     sub init_meta {
 113         my ( $self, %options ) = @_;
 114         return Moose::Util::MetaRole::apply_metaclass_roles(
 115             for_class       => Moose::Role->init_meta(%options),
 116             metaclass_roles => ['Role::WithCustomApplication'],
 117             application_to_class_class_roles =>
 118                 ['CustomApplication::ToClass'],
 119             application_to_role_class_roles => ['CustomApplication::ToRole'],
 120             application_to_instance_class_roles =>
 121                 ['CustomApplication::ToInstance'],
 122         );
 123     }
 124 }
 125
 126 {
 127     package My::Role::Normal;
 128     use Moose::Role;
 129 }
 130
 131 {
 132     package My::Role::Special;
 133     CustomRole->import;
 134 }
 135
 136 ok( My::Role::Normal->meta->isa('Moose::Meta::Role'), "sanity check" );
 137 ok( My::Role::Special->meta->isa('Moose::Meta::Role'),
 138     "using custom application roles does not change the role metaobject's class"
 139 );
 140 ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'),
 141     "the role's metaobject has custom applications" );
 142 is_deeply( [My::Role::Special->meta->composition_class_roles],
 143     ['Role::Composite'],
 144     "the role knows about the specified composition class" );
 145
 146 {
 147     package Foo;
 148     use Moose;
 149
 150     local @applications;
 151     with 'My::Role::Special';
 152
 153     ::is( @applications, 1, 'one role application' );
 154     ::is( $applications[0]->[0]->name, 'My::Role::Special',
 155         "the application's first role was My::Role::Special'" );
 156     ::is( $applications[0]->[1]->name, 'Foo',
 157         "the application provided an additional role" );
 158 }
 159
 160 {
 161     package Bar;
 162     use Moose::Role;
 163
 164     local @applications;
 165     with 'My::Role::Special';
 166
 167     ::is( @applications,               1 );
 168     ::is( $applications[0]->[0]->name, 'My::Role::Special' );
 169     ::is( $applications[0]->[1]->name, 'Bar' );
 170 }
 171
 172 {
 173     package Baz;
 174     use Moose;
 175
 176     my $i = Baz->new;
 177     local @applications;
 178     My::Role::Special->meta->apply($i);
 179
 180     ::is( @applications,               1 );
 181     ::is( $applications[0]->[0]->name, 'My::Role::Special' );
 182     ::ok( $applications[0]->[1]->is_anon_class );
 183     ::ok( $applications[0]->[1]->name->isa('Baz') );
 184 }
 185
 186 {
 187     package Corge;
 188     use Moose;
 189
 190     local @applications;
 191     with 'My::Role::Normal', 'My::Role::Special';
 192
 193     ::is( @applications,               2 );
 194     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 195     ::is( $applications[0]->[1]->name, 'Corge' );
 196     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 197     ::is( $applications[1]->[1]->name, 'Corge' );
 198 }
 199
 200 {
 201     package Thud;
 202     use Moose::Role;
 203
 204     local @applications;
 205     with 'My::Role::Normal', 'My::Role::Special';
 206
 207     ::is( @applications,               2 );
 208     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 209     ::is( $applications[0]->[1]->name, 'Thud' );
 210     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 211     ::is( $applications[1]->[1]->name, 'Thud' );
 212 }
 213
 214 {
 215     package Garply;
 216     use Moose;
 217
 218     my $i = Garply->new;
 219     local @applications;
 220     Moose::Meta::Role->combine(
 221         [ 'My::Role::Normal'  => undef ],
 222         [ 'My::Role::Special' => undef ],
 223     )->apply($i);
 224
 225     ::is( @applications,               2 );
 226     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 227     ::ok( $applications[0]->[1]->is_anon_class );
 228     ::ok( $applications[0]->[1]->name->isa('Garply') );
 229     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 230     ::ok( $applications[1]->[1]->is_anon_class );
 231     ::ok( $applications[1]->[1]->name->isa('Garply') );
 232 }
 233
 234 done_testing;