t/050_metaclasses/failing/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 Mouse::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 Mouse::Role;
  25
  26     with 'CustomApplication';
  27 }
  28
  29 {
  30     package CustomApplication::ToRole;
  31     use Mouse::Role;
  32
  33     with 'CustomApplication';
  34 }
  35
  36 {
  37     package CustomApplication::ToInstance;
  38     use Mouse::Role;
  39
  40     with 'CustomApplication';
  41 }
  42
  43 {
  44     package CustomApplication::Composite;
  45     use Mouse::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 Mouse::Role;
  60
  61     with 'CustomApplication::Composite';
  62 }
  63
  64 {
  65     package CustomApplication::Composite::ToRole;
  66     use Mouse::Role;
  67
  68     with 'CustomApplication::Composite';
  69 }
  70
  71 {
  72     package CustomApplication::Composite::ToInstance;
  73     use Mouse::Role;
  74
  75     with 'CustomApplication::Composite';
  76 }
  77
  78 {
  79     package Role::Composite;
  80     use Mouse::Role;
  81
  82     around apply_params => sub {
  83         my ( $next, $self, @args ) = @_;
  84         return Mouse::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 Mouse::Role;
  99
 100     has '+composition_class_roles' => (
 101         default => ['Role::Composite'],
 102     );
 103 }
 104
 105 {
 106     package CustomRole;
 107     Mouse::Exporter->setup_import_methods(
 108         also => 'Mouse::Role',
 109     );
 110
 111     sub init_meta {
 112         my ( $self, %options ) = @_;
 113         return Mouse::Util::MetaRole::apply_metaclass_roles(
 114             for_class       => Mouse::Role->init_meta(%options),
 115             metaclass_roles => ['Role::WithCustomApplication'],
 116             application_to_class_class_roles =>
 117                 ['CustomApplication::ToClass'],
 118             application_to_role_class_roles => ['CustomApplication::ToRole'],
 119             application_to_instance_class_roles =>
 120                 ['CustomApplication::ToInstance'],
 121         );
 122     }
 123 }
 124
 125 {
 126     package My::Role::Normal;
 127     use Mouse::Role;
 128 }
 129
 130 {
 131     package My::Role::Special;
 132     CustomRole->import;
 133 }
 134
 135 ok( My::Role::Normal->meta->isa('Mouse::Meta::Role'), "sanity check" );
 136 ok( My::Role::Special->meta->isa('Mouse::Meta::Role'),
 137     "using custom application roles does not change the role metaobject's class"
 138 );
 139 ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'),
 140     "the role's metaobject has custom applications" );
 141 is_deeply( My::Role::Special->meta->composition_class_roles,
 142     ['Role::Composite'],
 143     "the role knows about the specified composition class" );
 144
 145 {
 146     package Foo;
 147     use Mouse;
 148
 149     local @applications;
 150     with 'My::Role::Special';
 151
 152     ::is( @applications, 1, 'one role application' );
 153     ::is( $applications[0]->[0]->name, 'My::Role::Special',
 154         "the application's first role was My::Role::Special'" );
 155     ::is( $applications[0]->[1]->name, 'Foo',
 156         "the application provided an additional role" );
 157 }
 158
 159 {
 160     package Bar;
 161     use Mouse::Role;
 162
 163     local @applications;
 164     with 'My::Role::Special';
 165
 166     ::is( @applications,               1 );
 167     ::is( $applications[0]->[0]->name, 'My::Role::Special' );
 168     ::is( $applications[0]->[1]->name, 'Bar' );
 169 }
 170
 171 {
 172     package Baz;
 173     use Mouse;
 174
 175     my $i = Baz->new;
 176     local @applications;
 177     My::Role::Special->meta->apply($i);
 178
 179     ::is( @applications,               1 );
 180     ::is( $applications[0]->[0]->name, 'My::Role::Special' );
 181     ::ok( $applications[0]->[1]->is_anon_class );
 182     ::ok( $applications[0]->[1]->name->isa('Baz') );
 183 }
 184
 185 {
 186     package Corge;
 187     use Mouse;
 188
 189     local @applications;
 190     with 'My::Role::Normal', 'My::Role::Special';
 191
 192     ::is( @applications,               2 );
 193     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 194     ::is( $applications[0]->[1]->name, 'Corge' );
 195     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 196     ::is( $applications[1]->[1]->name, 'Corge' );
 197 }
 198
 199 {
 200     package Thud;
 201     use Mouse::Role;
 202
 203     local @applications;
 204     with 'My::Role::Normal', 'My::Role::Special';
 205
 206     ::is( @applications,               2 );
 207     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 208     ::is( $applications[0]->[1]->name, 'Thud' );
 209     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 210     ::is( $applications[1]->[1]->name, 'Thud' );
 211 }
 212
 213 {
 214     package Garply;
 215     use Mouse;
 216
 217     my $i = Garply->new;
 218     local @applications;
 219     Mouse::Meta::Role->combine(
 220         [ 'My::Role::Normal'  => undef ],
 221         [ 'My::Role::Special' => undef ],
 222     )->apply($i);
 223
 224     ::is( @applications,               2 );
 225     ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
 226     ::ok( $applications[0]->[1]->is_anon_class );
 227     ::ok( $applications[0]->[1]->name->isa('Garply') );
 228     ::is( $applications[1]->[0]->name, 'My::Role::Special' );
 229     ::ok( $applications[1]->[1]->is_anon_class );
 230     ::ok( $applications[1]->[1]->name->isa('Garply') );
 231 }
 232
 233 done_testing;