t/050_metaclasses/015_metarole.t

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