t/050_metaclasses/015_metarole.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 68;
   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 Role::Foo;
  19     use Moose::Role;
  20     has 'foo' => ( is => 'ro', default => 10 );
  21 }
  22
  23 {
  24     package My::Class;
  25
  26     use Moose;
  27 }
  28
  29 {
  30     Moose::Util::MetaRole::apply_metaclass_roles(
  31         for_class       => 'My::Class',
  32         metaclass_roles => ['Role::Foo'],
  33     );
  34
  35     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  36         'apply Role::Foo to My::Class->meta()' );
  37     is( My::Class->meta()->foo(), 10,
  38         '... and call foo() on that meta object' );
  39 }
  40
  41 {
  42     Moose::Util::MetaRole::apply_metaclass_roles(
  43         for_class                 => 'My::Class',
  44         attribute_metaclass_roles => ['Role::Foo'],
  45     );
  46
  47     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  48         q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
  49     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  50         '... My::Class->meta() still does Role::Foo' );
  51
  52     My::Class->meta()->add_attribute( 'size', is => 'ro' );
  53     is( My::Class->meta()->get_attribute('size')->foo(), 10,
  54         '... call foo() on an attribute metaclass object' );
  55 }
  56
  57 {
  58     Moose::Util::MetaRole::apply_metaclass_roles(
  59         for_class              => 'My::Class',
  60         method_metaclass_roles => ['Role::Foo'],
  61     );
  62
  63     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  64         q{apply Role::Foo to My::Class->meta()'s method metaclass} );
  65     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  66         '... My::Class->meta() still does Role::Foo' );
  67     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  68         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
  69
  70     My::Class->meta()->add_method( 'bar' => sub { 'bar' } );
  71     is( My::Class->meta()->get_method('bar')->foo(), 10,
  72         '... call foo() on a method metaclass object' );
  73 }
  74
  75 {
  76     Moose::Util::MetaRole::apply_metaclass_roles(
  77         for_class              => 'My::Class',
  78         instance_metaclass_roles => ['Role::Foo'],
  79     );
  80
  81     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
  82         q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
  83     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  84         '... My::Class->meta() still does Role::Foo' );
  85     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  86         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
  87     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  88         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
  89
  90     is( My::Class->meta()->get_meta_instance()->foo(), 10,
  91         '... call foo() on an instance metaclass object' );
  92 }
  93
  94 {
  95     Moose::Util::MetaRole::apply_metaclass_roles(
  96         for_class               => 'My::Class',
  97         constructor_class_roles => ['Role::Foo'],
  98     );
  99
 100     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 101         q{apply Role::Foo to My::Class->meta()'s constructor class} );
 102     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 103         '... My::Class->meta() still does Role::Foo' );
 104     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 105         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 106     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 107         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 108     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 109         q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 110
 111     # Actually instantiating the constructor class is too freaking hard!
 112     ok( My::Class->meta()->constructor_class()->can('foo'),
 113         '... constructor class has a foo method' );
 114 }
 115
 116 {
 117     Moose::Util::MetaRole::apply_metaclass_roles(
 118         for_class              => 'My::Class',
 119         destructor_class_roles => ['Role::Foo'],
 120     );
 121
 122     ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 123         q{apply Role::Foo to My::Class->meta()'s destructor class} );
 124     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 125         '... My::Class->meta() still does Role::Foo' );
 126     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 127         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 128     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 129         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 130     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 131         q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 132     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 133         q{... My::Class->meta()'s constructor class still does Role::Foo} );
 134
 135     # same problem as the constructor class
 136     ok( My::Class->meta()->destructor_class()->can('foo'),
 137         '... destructor class has a foo method' );
 138 }
 139
 140 {
 141     Moose::Util::MetaRole::apply_base_class_roles(
 142         for_class => 'My::Class',
 143         roles     => ['Role::Foo'],
 144     );
 145
 146     ok( My::Class->meta()->does_role('Role::Foo'),
 147         'apply Role::Foo to My::Class base class' );
 148     is( My::Class->new()->foo(), 10,
 149         '... call foo() on a My::Class object' );
 150 }
 151
 152 {
 153     package My::Class2;
 154
 155     use Moose;
 156 }
 157
 158 {
 159     Moose::Util::MetaRole::apply_metaclass_roles(
 160         for_class                 => 'My::Class2',
 161         metaclass_roles           => ['Role::Foo'],
 162         attribute_metaclass_roles => ['Role::Foo'],
 163         method_metaclass_roles    => ['Role::Foo'],
 164         instance_metaclass_roles  => ['Role::Foo'],
 165         constructor_class_roles   => ['Role::Foo'],
 166         destructor_class_roles    => ['Role::Foo'],
 167     );
 168
 169     ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
 170         'apply Role::Foo to My::Class2->meta()' );
 171     is( My::Class2->meta()->foo(), 10,
 172         '... and call foo() on that meta object' );
 173     ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 174         q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
 175     My::Class2->meta()->add_attribute( 'size', is => 'ro' );
 176
 177     is( My::Class2->meta()->get_attribute('size')->foo(), 10,
 178         '... call foo() on an attribute metaclass object' );
 179
 180     ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 181         q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
 182
 183     My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
 184     is( My::Class2->meta()->get_method('bar')->foo(), 10,
 185         '... call foo() on a method metaclass object' );
 186
 187     ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 188         q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
 189     is( My::Class2->meta()->get_meta_instance()->foo(), 10,
 190         '... call foo() on an instance metaclass object' );
 191
 192     ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 193         q{apply Role::Foo to My::Class2->meta()'s constructor class} );
 194     ok( My::Class2->meta()->constructor_class()->can('foo'),
 195         '... constructor class has a foo method' );
 196
 197     ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 198         q{apply Role::Foo to My::Class2->meta()'s destructor class} );
 199     ok( My::Class2->meta()->destructor_class()->can('foo'),
 200         '... destructor class has a foo method' );
 201 }
 202
 203
 204 {
 205     package My::Meta;
 206
 207     use Moose::Exporter;
 208     Moose::Exporter->setup_import_methods( also => 'Moose' );
 209
 210     sub init_meta {
 211         shift;
 212         my %p = @_;
 213
 214         Moose->init_meta( %p, metaclass => 'My::Meta::Class' );
 215     }
 216 }
 217
 218 {
 219     package My::Class3;
 220
 221     My::Meta->import();
 222 }
 223
 224
 225 {
 226     Moose::Util::MetaRole::apply_metaclass_roles(
 227         for_class                 => 'My::Class3',
 228         metaclass_roles           => ['Role::Foo'],
 229     );
 230
 231     ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
 232         'apply Role::Foo to My::Class3->meta()' );
 233     is( My::Class3->meta()->foo(), 10,
 234         '... and call foo() on that meta object' );
 235     ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
 236         'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' );
 237 }
 238
 239 {
 240     package Role::Bar;
 241     use Moose::Role;
 242     has 'bar' => ( is => 'ro', default => 200 );
 243 }
 244
 245 {
 246     package My::Class4;
 247     use Moose;
 248 }
 249
 250 {
 251     Moose::Util::MetaRole::apply_metaclass_roles(
 252         for_class                 => 'My::Class4',
 253         metaclass_roles           => ['Role::Foo'],
 254     );
 255
 256     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 257         'apply Role::Foo to My::Class4->meta()' );
 258
 259     Moose::Util::MetaRole::apply_metaclass_roles(
 260         for_class                 => 'My::Class4',
 261         metaclass_roles           => ['Role::Bar'],
 262     );
 263
 264     ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
 265         'apply Role::Bar to My::Class4->meta()' );
 266     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 267         '... and My::Class4->meta() still does Role::Foo' );
 268 }
 269
 270 {
 271     package My::Class5;
 272     use Moose;
 273
 274     extends 'My::Class';
 275 }
 276
 277 {
 278     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 279         q{My::Class55->meta()'s does Role::Foo because it extends My::Class} );
 280     ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 281         q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
 282     ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 283         q{My::Class5->meta()'s method metaclass also does Role::Foo} );
 284     ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 285         q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
 286     ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 287         q{My::Class5->meta()'s constructor class also does Role::Foo} );
 288     ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 289         q{My::Class5->meta()'s destructor class also does Role::Foo} );
 290 }
 291
 292 {
 293     Moose::Util::MetaRole::apply_metaclass_roles(
 294         for_class       => 'My::Class5',
 295         metaclass_roles => ['Role::Bar'],
 296     );
 297
 298     ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
 299         q{apply Role::Bar My::Class5->meta()} );
 300     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 301         q{... and My::Class5->meta() still does Role::Foo} );
 302 }
 303
 304 {
 305     package My::Class6;
 306     use Moose;
 307
 308     Moose::Util::MetaRole::apply_metaclass_roles(
 309         for_class       => 'My::Class6',
 310         metaclass_roles => ['Role::Bar'],
 311     );
 312
 313     extends 'My::Class';
 314 }
 315
 316 {
 317     ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
 318         q{apply Role::Bar My::Class6->meta() before extends} );
 319     ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
 320         q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
 321 }
 322
 323 # This is the hack that used to be needed to work around the
 324 # _fix_metaclass_incompatibility problem. You called extends() (which
 325 # in turn calls _fix_metaclass_imcompatibility) _before_ you apply
 326 # more extensions in the subclass. We wabt to make sure this continues
 327 # to work in the future.
 328 {
 329     package My::Class7;
 330     use Moose;
 331
 332     # In real usage this would go in a BEGIN block so it happened
 333     # before apply_metaclass_roles was called by an extension.
 334     extends 'My::Class';
 335
 336     Moose::Util::MetaRole::apply_metaclass_roles(
 337         for_class       => 'My::Class7',
 338         metaclass_roles => ['Role::Bar'],
 339     );
 340 }
 341
 342 {
 343     ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
 344         q{apply Role::Bar My::Class7->meta() before extends} );
 345     ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
 346         q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
 347 }
 348
 349 {
 350     package My::Class8;
 351     use Moose;
 352
 353     Moose::Util::MetaRole::apply_metaclass_roles(
 354         for_class                 => 'My::Class8',
 355         metaclass_roles           => ['Role::Bar'],
 356         attribute_metaclass_roles => ['Role::Bar'],
 357     );
 358
 359     extends 'My::Class';
 360 }
 361
 362 {
 363     ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
 364         q{apply Role::Bar My::Class8->meta() before extends} );
 365     ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
 366         q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
 367     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 368         q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
 369     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 370         q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
 371 }
 372
 373
 374 {
 375     package My::Class9;
 376     use Moose;
 377
 378     Moose::Util::MetaRole::apply_metaclass_roles(
 379         for_class                 => 'My::Class9',
 380         attribute_metaclass_roles => ['Role::Bar'],
 381     );
 382
 383     extends 'My::Class';
 384 }
 385
 386 {
 387     ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
 388         q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
 389     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 390         q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
 391     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 392         q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
 393 }
 394
 395 # This tests applying meta roles to a metaclass's metaclass. This is
 396 # completely insane, but is exactly what happens with
 397 # Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class
 398 # itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass
 399 # for Fey::Meta::Class::Table does a role.
 400 #
 401 # At one point this caused a metaclass incompatibility error down
 402 # below, when we applied roles to the metaclass of My::Class10. It's
 403 # all madness but as long as the tests pass we're happy.
 404 {
 405     package My::Meta::Class2;
 406     use Moose;
 407     extends 'Moose::Meta::Class';
 408
 409     Moose::Util::MetaRole::apply_metaclass_roles(
 410         for_class       => 'My::Meta::Class2',
 411         metaclass_roles => ['Role::Foo'],
 412     );
 413 }
 414
 415 {
 416     package My::Meta2;
 417
 418     use Moose::Exporter;
 419     Moose::Exporter->setup_import_methods( also => 'Moose' );
 420
 421     sub init_meta {
 422         shift;
 423         my %p = @_;
 424
 425         Moose->init_meta( %p, metaclass => 'My::Meta::Class2' );
 426     }
 427 }
 428
 429 {
 430     package My::Class10;
 431     My::Meta2->import;
 432
 433     Moose::Util::MetaRole::apply_metaclass_roles(
 434         for_class       => 'My::Class10',
 435         metaclass_roles => ['Role::Bar'],
 436     );
 437 }
 438
 439 {
 440     ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
 441         q{My::Class10->meta()->meta() does Role::Foo } );
 442     ok( My::Class10->meta()->isa('My::Meta::Class2'),
 443         q{... and My::Class10->meta still isa(My::Meta::Class2)} );
 444 }