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_metaroles(
  85             for            => $self->$next(@args),
  86             role_metaroles => {
  87                 application_to_class =>
  88                     ['CustomApplication::Composite::ToClass'],
  89                 application_to_role =>
  90                     ['CustomApplication::Composite::ToRole'],
  91                 application_to_instance =>
  92                     ['CustomApplication::Composite::ToInstance'],
  93             },
  94         );
  95     };
  96 }
  97
  98 {
  99     package Role::WithCustomApplication;
 100     use Moose::Role;
 101
 102     around composition_class_roles => sub {
 103         my ($orig, $self) = @_;
 104         return $self->$orig, 'Role::Composite';
 105     };
 106 }
 107
 108 {
 109     package CustomRole;
 110     Moose::Exporter->setup_import_methods(
 111         also => 'Moose::Role',
 112     );
 113
 114     sub init_meta {
 115         my ( $self, %options ) = @_;
 116         return Moose::Util::MetaRole::apply_metaroles(
 117             for_class      => Moose::Role->init_meta(%options),
 118             role_metaroles => {
 119                 role => ['Role::WithCustomApplication'],
 120                 application_to_class =>
 121                     ['CustomApplication::ToClass'],
 122                 application_to_role => ['CustomApplication::ToRole'],
 123                 application_to_instance =>
 124                     ['CustomApplication::ToInstance'],
 125             },
 126         );
 127     }
 128 }
 129
 130 {
 131     package My::Role::Normal;
 132     use Moose::Role;
 133 }
 134
 135 {
 136     package My::Role::Special;
 137     CustomRole->import;
 138 }
 139
 140 ok( My::Role::Normal->meta->isa('Moose::Meta::Role'), "sanity check" );
 141 ok( My::Role::Special->meta->isa('Moose::Meta::Role'),
 142     "using custom application roles does not change the role metaobject's class"
 143 );
 144 ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'),
 145     "the role's metaobject has custom applications" );
 146 is_deeply( [My::Role::Special->meta->composition_class_roles],
 147     ['Role::Composite'],
 148     "the role knows about the specified composition class" );
 149
 150 {
 151     package Foo;
 152     use Moose;
 153
 154     local @applications;
 155     with 'My::Role::Special';
 156
 157     ::is( @applications, 1, 'one role application' );
 158     ::is( $applications[0]->[0]->name, 'My::Role::Special',
 159         "the application's first role was My::Role::Special'" );
 160     ::is( $applications[0]->[1]->name, 'Foo',
 161         "the application provided an additional role" );
 162 }
 163
 164 {
 165     package Bar;
 166     use Moose::Role;
 167
 168     local @applications;
 169     with 'My::Role::Special';
 170
 171     ::is( @applications,               1 );
 172     ::is( $applications[0]->[0]->name, 'My::Role::Special' );
 173     ::is( $applications[0]->[1]->name, 'Bar' );
 174 }
 175
 176 {
 177     package Baz;
 178     use Moose;
 179
 180     my $i = Baz->new;
 181     local @applications;
 182     My::Role::Special->meta->apply($i);
 183
 184     ::is( @applications,               1 );
 185     ::is( $applications[0]->[0]->name, 'My::Role::Special' );
 186     ::ok( $applications[0]->[1]->is_anon_class );
 187     ::ok( $applications[0]->[1]->name->isa('Baz') );
 188 }
 189
 190 {
 191     package Corge;
 192     use Moose;
 193
 194     local @applications;
 195     with 'My::Role::Normal', 'My::Role::Special';
 196
 197     ::is( @applications,               2 );
 198     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 199     ::is( $applications[0]->[1]->name, 'Corge' );
 200     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 201     ::is( $applications[1]->[1]->name, 'Corge' );
 202 }
 203
 204 {
 205     package Thud;
 206     use Moose::Role;
 207
 208     local @applications;
 209     with 'My::Role::Normal', 'My::Role::Special';
 210
 211     ::is( @applications,               2 );
 212     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 213     ::is( $applications[0]->[1]->name, 'Thud' );
 214     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 215     ::is( $applications[1]->[1]->name, 'Thud' );
 216 }
 217
 218 {
 219     package Garply;
 220     use Moose;
 221
 222     my $i = Garply->new;
 223     local @applications;
 224     Moose::Meta::Role->combine(
 225         [ 'My::Role::Normal'  => undef ],
 226         [ 'My::Role::Special' => undef ],
 227     )->apply($i);
 228
 229     ::is( @applications,               2 );
 230     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 231     ::ok( $applications[0]->[1]->is_anon_class );
 232     ::ok( $applications[0]->[1]->name->isa('Garply') );
 233     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 234     ::ok( $applications[1]->[1]->is_anon_class );
 235     ::ok( $applications[1]->[1]->name->isa('Garply') );
 236 }
 237
 238 done_testing;