t/050_metaclasses/015_metarole.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 59;
   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 }
 268
 269 {
 270     package Role::Bar;
 271     use Moose::Role;
 272     has 'bar' => ( is => 'ro', default => 200 );
 273 }
 274
 275 {
 276     package My::Class4;
 277     use Moose;
 278 }
 279
 280 {
 281     Moose::Util::MetaRole::apply_metaclass_roles(
 282         for_class                 => 'My::Class4',
 283         metaclass_roles           => ['Role::Foo'],
 284     );
 285
 286     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 287         'apply Role::Foo to My::Class4->meta()' );
 288
 289     Moose::Util::MetaRole::apply_metaclass_roles(
 290         for_class                 => 'My::Class4',
 291         metaclass_roles           => ['Role::Bar'],
 292     );
 293
 294     ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
 295         'apply Role::Bar to My::Class4->meta()' );
 296     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 297         '... and My::Class4->meta() still does Role::Foo' );
 298 }
 299
 300 {
 301     package My::Class5;
 302     use Moose;
 303
 304     extends 'My::Class';
 305 }
 306
 307 {
 308     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 309         q{My::Class55->meta()'s does Role::Foo because it extends My::Class} );
 310     ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 311         q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
 312     ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 313         q{My::Class5->meta()'s method metaclass also does Role::Foo} );
 314     ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 315         q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
 316     ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 317         q{My::Class5->meta()'s constructor class also does Role::Foo} );
 318     ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 319         q{My::Class5->meta()'s destructor class also does Role::Foo} );
 320 }
 321
 322 {
 323     Moose::Util::MetaRole::apply_metaclass_roles(
 324         for_class       => 'My::Class5',
 325         metaclass_roles => ['Role::Bar'],
 326     );
 327
 328     ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
 329         q{apply Role::Bar My::Class5->meta()} );
 330     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 331         q{... and My::Class5->meta() still does Role::Foo} );
 332 }
 333
 334 SKIP:
 335 {
 336     skip
 337         'These tests will fail until Moose::Meta::Class->_fix_metaclass_incompatibility is much smarter.',
 338         2;
 339
 340 {
 341     package My::Class6;
 342     use Moose;
 343
 344     Moose::Util::MetaRole::apply_metaclass_roles(
 345         for_class       => 'My::Class6',
 346         metaclass_roles => ['Role::Bar'],
 347     );
 348
 349     extends 'My::Class';
 350 }
 351
 352 {
 353     ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
 354         q{apply Role::Bar My::Class6->meta() before extends} );
 355     ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
 356         q{... and My::Class6->meta() does Role::Foo because it extends My::Class} );
 357 }
 358 }
 359
 360 # This is the hack needed to work around the
 361 # _fix_metaclass_incompatibility problem. You must call extends()
 362 # (which in turn calls _fix_metaclass_imcompatibility) _before_ you
 363 # apply more extensions in the subclass.
 364 {
 365     package My::Class7;
 366     use Moose;
 367
 368     # In real usage this would go in a BEGIN block so it happened
 369     # before apply_metaclass_roles was called by an extension.
 370     extends 'My::Class';
 371
 372     Moose::Util::MetaRole::apply_metaclass_roles(
 373         for_class       => 'My::Class7',
 374         metaclass_roles => ['Role::Bar'],
 375     );
 376 }
 377
 378 {
 379     ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
 380         q{apply Role::Bar My::Class7->meta() before extends} );
 381     ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
 382         q{... and My::Class7->meta() does Role::Foo because it extends My::Class} );
 383 }