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