t/050_metaclasses/015_metarole.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More 'no_plan';
   7
   8 use Moose::Util::MetaRole;
   9
  10
  11 {
  12     package My::Meta::Class;
  13     use Moose;
  14     extends 'Moose::Meta::Class';
  15 }
  16
  17 {
  18     package My::Meta::Attribute;
  19     use Moose;
  20     extends 'Moose::Meta::Attribute';
  21 }
  22
  23 {
  24     package My::Meta::Method;
  25     use Moose;
  26     extends 'Moose::Meta::Method';
  27 }
  28
  29 {
  30     package My::Meta::Instance;
  31     use Moose;
  32     extends 'Moose::Meta::Instance';
  33 }
  34
  35 {
  36     package My::Meta::MethodConstructor;
  37     use Moose;
  38     extends 'Moose::Meta::Method::Constructor';
  39 }
  40
  41 {
  42     package My::Meta::MethodDestructor;
  43     use Moose;
  44     extends 'Moose::Meta::Method::Destructor';
  45 }
  46
  47 {
  48     package Role::Foo;
  49     use Moose::Role;
  50     has 'foo' => ( is => 'ro', default => 10 );
  51 }
  52
  53 {
  54     package My::Class;
  55
  56     use Moose;
  57 }
  58
  59 {
  60     Moose::Util::MetaRole::apply_metaclass_roles(
  61         for_class       => 'My::Class',
  62         metaclass_roles => ['Role::Foo'],
  63     );
  64
  65     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  66         'apply Role::Foo to My::Class->meta()' );
  67     is( My::Class->meta()->foo(), 10,
  68         '... and call foo() on that meta object' );
  69 }
  70
  71 {
  72     Moose::Util::MetaRole::apply_metaclass_roles(
  73         for_class                 => 'My::Class',
  74         attribute_metaclass_roles => ['Role::Foo'],
  75     );
  76
  77     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  78         q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
  79     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  80         '... My::Class->meta() still does Role::Foo' );
  81
  82     My::Class->meta()->add_attribute( 'size', is => 'ro' );
  83     is( My::Class->meta()->get_attribute('size')->foo(), 10,
  84         '... call foo() on an attribute metaclass object' );
  85 }
  86
  87 {
  88     Moose::Util::MetaRole::apply_metaclass_roles(
  89         for_class              => 'My::Class',
  90         method_metaclass_roles => ['Role::Foo'],
  91     );
  92
  93     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  94         q{apply Role::Foo to My::Class->meta()'s method metaclass} );
  95     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  96         '... My::Class->meta() still does Role::Foo' );
  97     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  98         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
  99
 100     My::Class->meta()->add_method( 'bar' => sub { 'bar' } );
 101     is( My::Class->meta()->get_method('bar')->foo(), 10,
 102         '... call foo() on a method metaclass object' );
 103 }
 104
 105 {
 106     Moose::Util::MetaRole::apply_metaclass_roles(
 107         for_class              => 'My::Class',
 108         instance_metaclass_roles => ['Role::Foo'],
 109     );
 110
 111     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 112         q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
 113     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 114         '... My::Class->meta() still does Role::Foo' );
 115     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 116         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 117     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 118         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 119
 120     is( My::Class->meta()->get_meta_instance()->foo(), 10,
 121         '... call foo() on an instance metaclass object' );
 122 }
 123
 124 {
 125     Moose::Util::MetaRole::apply_metaclass_roles(
 126         for_class               => 'My::Class',
 127         constructor_class_roles => ['Role::Foo'],
 128     );
 129
 130     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 131         q{apply Role::Foo to My::Class->meta()'s constructor class} );
 132     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 133         '... My::Class->meta() still does Role::Foo' );
 134     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 135         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 136     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 137         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 138     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 139         q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 140
 141     # Actually instantiating the constructor class is too freaking hard!
 142     ok( My::Class->meta()->constructor_class()->can('foo'),
 143         '... constructor class has a foo method' );
 144 }
 145
 146 {
 147     Moose::Util::MetaRole::apply_metaclass_roles(
 148         for_class              => 'My::Class',
 149         destructor_class_roles => ['Role::Foo'],
 150     );
 151
 152     ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 153         q{apply Role::Foo to My::Class->meta()'s destructor class} );
 154     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 155         '... My::Class->meta() still does Role::Foo' );
 156     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 157         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 158     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 159         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 160     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 161         q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 162     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 163         q{... My::Class->meta()'s constructor class still does Role::Foo} );
 164
 165     # same problem as the constructor class
 166     ok( My::Class->meta()->destructor_class()->can('foo'),
 167         '... destructor class has a foo method' );
 168 }
 169
 170 {
 171     Moose::Util::MetaRole::apply_base_class_roles(
 172         for_class => 'My::Class',
 173         roles     => ['Role::Foo'],
 174     );
 175
 176     ok( My::Class->meta()->does_role('Role::Foo'),
 177         'apply Role::Foo to My::Class base class' );
 178     is( My::Class->new()->foo(), 10,
 179         '... call foo() on a My::Class object' );
 180 }
 181
 182 {
 183     package My::Class2;
 184
 185     use Moose;
 186 }
 187
 188 {
 189     Moose::Util::MetaRole::apply_metaclass_roles(
 190         for_class                 => 'My::Class2',
 191         metaclass_roles           => ['Role::Foo'],
 192         attribute_metaclass_roles => ['Role::Foo'],
 193         method_metaclass_roles    => ['Role::Foo'],
 194         instance_metaclass_roles  => ['Role::Foo'],
 195         constructor_class_roles   => ['Role::Foo'],
 196         destructor_class_roles    => ['Role::Foo'],
 197     );
 198
 199     ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
 200         'apply Role::Foo to My::Class2->meta()' );
 201     is( My::Class2->meta()->foo(), 10,
 202         '... and call foo() on that meta object' );
 203     ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 204         q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
 205     My::Class2->meta()->add_attribute( 'size', is => 'ro' );
 206
 207     is( My::Class2->meta()->get_attribute('size')->foo(), 10,
 208         '... call foo() on an attribute metaclass object' );
 209
 210     ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 211         q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
 212
 213     My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
 214     is( My::Class2->meta()->get_method('bar')->foo(), 10,
 215         '... call foo() on a method metaclass object' );
 216
 217     ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 218         q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
 219     is( My::Class2->meta()->get_meta_instance()->foo(), 10,
 220         '... call foo() on an instance metaclass object' );
 221
 222     ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 223         q{apply Role::Foo to My::Class2->meta()'s constructor class} );
 224     ok( My::Class2->meta()->constructor_class()->can('foo'),
 225         '... constructor class has a foo method' );
 226
 227     ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 228         q{apply Role::Foo to My::Class2->meta()'s destructor class} );
 229     ok( My::Class2->meta()->destructor_class()->can('foo'),
 230         '... destructor class has a foo method' );
 231 }
 232
 233
 234 {
 235     package My::Meta;
 236
 237     use Moose::Exporter;
 238     Moose::Exporter->setup_import_methods( also => 'Moose' );
 239
 240     sub init_meta {
 241         shift;
 242         my %p = @_;
 243
 244         Moose->init_meta( %p, metaclass => 'My::Meta::Class' );
 245     }
 246 }
 247
 248 {
 249     package My::Class3;
 250
 251     My::Meta->import();
 252 }
 253
 254
 255 {
 256     Moose::Util::MetaRole::apply_metaclass_roles(
 257         for_class                 => 'My::Class3',
 258         metaclass_roles           => ['Role::Foo'],
 259     );
 260
 261     ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
 262         'apply Role::Foo to My::Class3->meta()' );
 263     is( My::Class3->meta()->foo(), 10,
 264         '... and call foo() on that meta object' );
 265     ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
 266         'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' );
 267 }