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 'no_plan';
   9 use Test::Exception;
  10
  11 use Mouse::Util::MetaRole;
  12
  13
  14 {
  15     package My::Meta::Class;
  16     use Mouse;
  17     extends 'Mouse::Meta::Class';
  18 }
  19
  20 {
  21     package Role::Foo;
  22     use Mouse::Role;
  23     has 'foo' => ( is => 'ro', default => 10 );
  24 }
  25
  26 {
  27     package My::Class;
  28
  29     use Mouse;
  30 }
  31
  32 {
  33     package My::Role;
  34     use Mouse::Role;
  35 }
  36
  37 {
  38     Mouse::Util::MetaRole::apply_metaclass_roles(
  39         for_class       => My::Class->meta,
  40         metaclass_roles => ['Role::Foo'],
  41     );
  42
  43     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  44         'apply Role::Foo to My::Class->meta()' );
  45     is( My::Class->meta()->foo(), 10,
  46         '... and call foo() on that meta object' );
  47 }
  48
  49 {
  50     Mouse::Util::MetaRole::apply_metaclass_roles(
  51         for_class                 => 'My::Class',
  52         attribute_metaclass_roles => ['Role::Foo'],
  53     );
  54
  55     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  56         q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
  57     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  58         '... My::Class->meta() still does Role::Foo' );
  59
  60     My::Class->meta()->add_attribute( 'size', is => 'ro' );
  61     is( My::Class->meta()->get_attribute('size')->foo(), 10,
  62         '... call foo() on an attribute metaclass object' );
  63 }
  64
  65 {
  66     Mouse::Util::MetaRole::apply_metaclass_roles(
  67         for_class              => 'My::Class',
  68         method_metaclass_roles => ['Role::Foo'],
  69     );
  70
  71     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  72         q{apply Role::Foo to My::Class->meta()'s method metaclass} );
  73     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  74         '... My::Class->meta() still does Role::Foo' );
  75     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  76         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
  77
  78     My::Class->meta()->add_method( 'bar' => sub { 'bar' } );
  79     is( My::Class->meta()->get_method('bar')->foo(), 10,
  80         '... call foo() on a method metaclass object' );
  81 }
  82
  83 {
  84     last; # skip
  85     Mouse::Util::MetaRole::apply_metaclass_roles(
  86         for_class                      => 'My::Class',
  87         wrapped_method_metaclass_roles => ['Role::Foo'],
  88     );
  89
  90     ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'),
  91         q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} );
  92     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  93         '... My::Class->meta() still does Role::Foo' );
  94     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  95         '... My::Class->meta() still does Role::Foo' );
  96     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  97         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
  98
  99     My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } );
 100     is( My::Class->meta()->get_method('bar')->foo(), 10,
 101         '... call foo() on a wrapped method metaclass object' );
 102 }
 103
 104 {
 105     last; # skip
 106
 107     Mouse::Util::MetaRole::apply_metaclass_roles(
 108         for_class              => 'My::Class',
 109         instance_metaclass_roles => ['Role::Foo'],
 110     );
 111
 112     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 113         q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
 114     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 115         '... My::Class->meta() still does Role::Foo' );
 116     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 117         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 118     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 119         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 120
 121     is( My::Class->meta()->get_meta_instance()->foo(), 10,
 122         '... call foo() on an instance metaclass object' );
 123 }
 124
 125 {
 126     Mouse::Util::MetaRole::apply_metaclass_roles(
 127         for_class               => 'My::Class',
 128         constructor_class_roles => ['Role::Foo'],
 129     );
 130
 131     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 132         q{apply Role::Foo to My::Class->meta()'s constructor class} );
 133     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 134         '... My::Class->meta() still does Role::Foo' );
 135     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 136         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 137     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 138         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 139 #    ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 140 #        q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 141
 142     # Actually instantiating the constructor class is too freaking hard!
 143     ok( My::Class->meta()->constructor_class()->can('foo'),
 144         '... constructor class has a foo method' );
 145 }
 146
 147 {
 148     Mouse::Util::MetaRole::apply_metaclass_roles(
 149         for_class              => 'My::Class',
 150         destructor_class_roles => ['Role::Foo'],
 151     );
 152
 153     ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 154         q{apply Role::Foo to My::Class->meta()'s destructor class} );
 155     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 156         '... My::Class->meta() still does Role::Foo' );
 157     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 158         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 159     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 160         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 161 #    ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 162 #        q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 163     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 164         q{... My::Class->meta()'s constructor class still does Role::Foo} );
 165
 166     # same problem as the constructor class
 167     ok( My::Class->meta()->destructor_class()->can('foo'),
 168         '... destructor class has a foo method' );
 169 }
 170
 171 {
 172     last; # skip
 173
 174     Mouse::Util::MetaRole::apply_metaclass_roles(
 175         for_class                        => 'My::Role',
 176         application_to_class_class_roles => ['Role::Foo'],
 177     );
 178
 179     ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
 180         q{apply Role::Foo to My::Role->meta's application_to_class class} );
 181
 182     is( My::Role->meta->application_to_class_class->new->foo, 10,
 183         q{... call foo() on an application_to_class instance} );
 184 }
 185
 186 {
 187     last; # skip
 188
 189     Mouse::Util::MetaRole::apply_metaclass_roles(
 190         for_class                        => 'My::Role',
 191         application_to_role_class_roles => ['Role::Foo'],
 192     );
 193
 194     ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
 195         q{apply Role::Foo to My::Role->meta's application_to_role class} );
 196     ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
 197         q{... My::Role->meta's application_to_class class still does Role::Foo} );
 198
 199     is( My::Role->meta->application_to_role_class->new->foo, 10,
 200         q{... call foo() on an application_to_role instance} );
 201 }
 202
 203 {
 204     last; # skip
 205
 206     Mouse::Util::MetaRole::apply_metaclass_roles(
 207         for_class                           => 'My::Role',
 208         application_to_instance_class_roles => ['Role::Foo'],
 209     );
 210
 211     ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'),
 212         q{apply Role::Foo to My::Role->meta's application_to_instance class} );
 213     ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
 214         q{... My::Role->meta's application_to_role class still does Role::Foo} );
 215     ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
 216         q{... My::Role->meta's application_to_class class still does Role::Foo} );
 217
 218     is( My::Role->meta->application_to_instance_class->new->foo, 10,
 219         q{... call foo() on an application_to_instance instance} );
 220 }
 221
 222 {
 223     Mouse::Util::MetaRole::apply_base_class_roles(
 224         for_class => 'My::Class',
 225         roles     => ['Role::Foo'],
 226     );
 227
 228     ok( My::Class->meta()->does_role('Role::Foo'),
 229         'apply Role::Foo to My::Class base class' );
 230     is( My::Class->new()->foo(), 10,
 231         '... call foo() on a My::Class object' );
 232 }
 233
 234 {
 235     package My::Class2;
 236
 237     use Mouse;
 238 }
 239
 240 {
 241     Mouse::Util::MetaRole::apply_metaclass_roles(
 242         for_class                 => 'My::Class2',
 243         metaclass_roles           => ['Role::Foo'],
 244         attribute_metaclass_roles => ['Role::Foo'],
 245         method_metaclass_roles    => ['Role::Foo'],
 246         instance_metaclass_roles  => ['Role::Foo'],
 247         constructor_class_roles   => ['Role::Foo'],
 248         destructor_class_roles    => ['Role::Foo'],
 249     );
 250
 251     ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
 252         'apply Role::Foo to My::Class2->meta()' );
 253     is( My::Class2->meta()->foo(), 10,
 254         '... and call foo() on that meta object' );
 255     ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 256         q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
 257     My::Class2->meta()->add_attribute( 'size', is => 'ro' );
 258
 259     is( My::Class2->meta()->get_attribute('size')->foo(), 10,
 260         '... call foo() on an attribute metaclass object' );
 261
 262     ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 263         q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
 264
 265     My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
 266     is( My::Class2->meta()->get_method('bar')->foo(), 10,
 267         '... call foo() on a method metaclass object' );
 268
 269 #    ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 270 #        q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
 271 #    is( My::Class2->meta()->get_meta_instance()->foo(), 10,
 272 #        '... call foo() on an instance metaclass object' );
 273
 274     ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 275         q{apply Role::Foo to My::Class2->meta()'s constructor class} );
 276     ok( My::Class2->meta()->constructor_class()->can('foo'),
 277         '... constructor class has a foo method' );
 278
 279     ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 280         q{apply Role::Foo to My::Class2->meta()'s destructor class} );
 281     ok( My::Class2->meta()->destructor_class()->can('foo'),
 282         '... destructor class has a foo method' );
 283 }
 284
 285
 286 {
 287     package My::Meta;
 288
 289     use Mouse::Exporter;
 290     Mouse::Exporter->setup_import_methods( also => 'Mouse' );
 291
 292     sub init_meta {
 293         shift;
 294         my %p = @_;
 295
 296         Mouse->init_meta( %p, metaclass => 'My::Meta::Class' );
 297     }
 298 }
 299
 300 {
 301     package My::Class3;
 302
 303     My::Meta->import();
 304 }
 305
 306
 307 {
 308     Mouse::Util::MetaRole::apply_metaclass_roles(
 309         for_class                 => 'My::Class3',
 310         metaclass_roles           => ['Role::Foo'],
 311     );
 312
 313     ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
 314         'apply Role::Foo to My::Class3->meta()' );
 315     is( My::Class3->meta()->foo(), 10,
 316         '... and call foo() on that meta object' );
 317     ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
 318         'apply_metaclass_roles() does not interfere with metaclass set via Mouse->init_meta()' );
 319 }
 320
 321 {
 322     package Role::Bar;
 323     use Mouse::Role;
 324     has 'bar' => ( is => 'ro', default => 200 );
 325 }
 326
 327 {
 328     package My::Class4;
 329     use Mouse;
 330 }
 331
 332 {
 333     Mouse::Util::MetaRole::apply_metaclass_roles(
 334         for_class                 => 'My::Class4',
 335         metaclass_roles           => ['Role::Foo'],
 336     );
 337
 338     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 339         'apply Role::Foo to My::Class4->meta()' );
 340
 341     Mouse::Util::MetaRole::apply_metaclass_roles(
 342         for_class                 => 'My::Class4',
 343         metaclass_roles           => ['Role::Bar'],
 344     );
 345
 346     ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
 347         'apply Role::Bar to My::Class4->meta()' );
 348     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 349         '... and My::Class4->meta() still does Role::Foo' );
 350 }
 351
 352 ## TODO@2009/11/17
 353
 354 exit(0);
 355
 356 {
 357     package My::Class5;
 358     use Mouse;
 359
 360     extends 'My::Class';
 361 }
 362
 363 {
 364     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 365         q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
 366     ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 367         q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
 368     ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 369         q{My::Class5->meta()'s method metaclass also does Role::Foo} );
 370     ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 371         q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
 372     ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 373         q{My::Class5->meta()'s constructor class also does Role::Foo} );
 374     ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 375         q{My::Class5->meta()'s destructor class also does Role::Foo} );
 376 }
 377 exit;
 378 {
 379     Mouse::Util::MetaRole::apply_metaclass_roles(
 380         for_class       => 'My::Class5',
 381         metaclass_roles => ['Role::Bar'],
 382     );
 383
 384     ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
 385         q{apply Role::Bar My::Class5->meta()} );
 386     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 387         q{... and My::Class5->meta() still does Role::Foo} );
 388 }
 389
 390 {
 391     package My::Class6;
 392     use Mouse;
 393
 394     Mouse::Util::MetaRole::apply_metaclass_roles(
 395         for_class       => 'My::Class6',
 396         metaclass_roles => ['Role::Bar'],
 397     );
 398
 399     extends 'My::Class';
 400 }
 401
 402 {
 403     ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
 404         q{apply Role::Bar My::Class6->meta() before extends} );
 405     ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
 406         q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
 407 }
 408
 409 # This is the hack that used to be needed to work around the
 410 # _fix_metaclass_incompatibility problem. You called extends() (which
 411 # in turn calls _fix_metaclass_imcompatibility) _before_ you apply
 412 # more extensions in the subclass. We wabt to make sure this continues
 413 # to work in the future.
 414 {
 415     package My::Class7;
 416     use Mouse;
 417
 418     # In real usage this would go in a BEGIN block so it happened
 419     # before apply_metaclass_roles was called by an extension.
 420     extends 'My::Class';
 421
 422     Mouse::Util::MetaRole::apply_metaclass_roles(
 423         for_class       => 'My::Class7',
 424         metaclass_roles => ['Role::Bar'],
 425     );
 426 }
 427
 428 {
 429     ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
 430         q{apply Role::Bar My::Class7->meta() before extends} );
 431     ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
 432         q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
 433 }
 434
 435 {
 436     package My::Class8;
 437     use Mouse;
 438
 439     Mouse::Util::MetaRole::apply_metaclass_roles(
 440         for_class                 => 'My::Class8',
 441         metaclass_roles           => ['Role::Bar'],
 442         attribute_metaclass_roles => ['Role::Bar'],
 443     );
 444
 445     extends 'My::Class';
 446 }
 447
 448 {
 449     ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
 450         q{apply Role::Bar My::Class8->meta() before extends} );
 451     ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
 452         q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
 453     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 454         q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
 455     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 456         q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
 457 }
 458
 459
 460 {
 461     package My::Class9;
 462     use Mouse;
 463
 464     Mouse::Util::MetaRole::apply_metaclass_roles(
 465         for_class                 => 'My::Class9',
 466         attribute_metaclass_roles => ['Role::Bar'],
 467     );
 468
 469     extends 'My::Class';
 470 }
 471
 472 {
 473     ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
 474         q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
 475     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 476         q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
 477     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 478         q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
 479 }
 480
 481 # This tests applying meta roles to a metaclass's metaclass. This is
 482 # completely insane, but is exactly what happens with
 483 # Fey::Meta::Class::Table. It's a subclass of Mouse::Meta::Class
 484 # itself, and then it _uses_ MouseX::ClassAttribute, so the metaclass
 485 # for Fey::Meta::Class::Table does a role.
 486 #
 487 # At one point this caused a metaclass incompatibility error down
 488 # below, when we applied roles to the metaclass of My::Class10. It's
 489 # all madness but as long as the tests pass we're happy.
 490 {
 491     package My::Meta::Class2;
 492     use Mouse;
 493     extends 'Mouse::Meta::Class';
 494
 495     Mouse::Util::MetaRole::apply_metaclass_roles(
 496         for_class       => 'My::Meta::Class2',
 497         metaclass_roles => ['Role::Foo'],
 498     );
 499 }
 500
 501 {
 502     package My::Object;
 503     use Mouse;
 504     extends 'Mouse::Object';
 505 }
 506
 507 {
 508     package My::Meta2;
 509
 510     use Mouse::Exporter;
 511     Mouse::Exporter->setup_import_methods( also => 'Mouse' );
 512
 513     sub init_meta {
 514         shift;
 515         my %p = @_;
 516
 517         Mouse->init_meta(
 518             %p,
 519             metaclass  => 'My::Meta::Class2',
 520             base_class => 'My::Object',
 521         );
 522     }
 523 }
 524
 525 {
 526     package My::Class10;
 527     My::Meta2->import;
 528
 529     Mouse::Util::MetaRole::apply_metaclass_roles(
 530         for_class       => 'My::Class10',
 531         metaclass_roles => ['Role::Bar'],
 532     );
 533 }
 534
 535 {
 536     ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
 537         q{My::Class10->meta()->meta() does Role::Foo } );
 538     ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
 539         q{My::Class10->meta()->meta() does Role::Bar } );
 540     ok( My::Class10->meta()->isa('My::Meta::Class2'),
 541         q{... and My::Class10->meta still isa(My::Meta::Class2)} );
 542     ok( My::Class10->isa('My::Object'),
 543         q{... and My::Class10 still isa(My::Object)} );
 544 }
 545
 546 {
 547     package My::Constructor;
 548
 549     use base 'Mouse::Meta::Method::Constructor';
 550 }
 551
 552 {
 553     package My::Class11;
 554
 555     use Mouse;
 556
 557     __PACKAGE__->meta->constructor_class('My::Constructor');
 558
 559     Mouse::Util::MetaRole::apply_metaclass_roles(
 560         for_class       => 'My::Class11',
 561         metaclass_roles => ['Role::Foo'],
 562     );
 563 }
 564
 565 {
 566     ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
 567         q{My::Class11->meta()->meta() does Role::Foo } );
 568     is( My::Class11->meta()->constructor_class, 'My::Constructor',
 569         q{... and explicitly set constructor_class value is unchanged)} );
 570 }
 571
 572 {
 573     package ExportsMouse;
 574
 575     Mouse::Exporter->setup_import_methods(
 576         also        => 'Mouse',
 577     );
 578
 579     sub init_meta {
 580         shift;
 581         my %p = @_;
 582         Mouse->init_meta(%p);
 583         return Mouse::Util::MetaRole::apply_metaclass_roles(
 584             for_class       => $p{for_class},
 585             # Causes us to recurse through init_meta, as we have to
 586             # load MyMetaclassRole from disk.
 587            metaclass_roles => [qw/MyMetaclassRole/],
 588         );
 589     }
 590 }
 591
 592 lives_ok {
 593     package UsesExportedMouse;
 594     ExportsMouse->import;
 595 } 'import module which loads a role from disk during init_meta';
 596
 597 {
 598     package Foo::Meta::Role;
 599
 600     use Mouse::Role;
 601 }
 602 {
 603     package Foo::Role;
 604
 605     Mouse::Exporter->setup_import_methods(
 606         also        => 'Mouse::Role',
 607     );
 608
 609     sub init_meta {
 610         shift;
 611         my %p = @_;
 612         Mouse::Role->init_meta(%p);
 613         return Mouse::Util::MetaRole::apply_metaclass_roles(
 614             for_class              => $p{for_class},
 615             method_metaclass_roles => [ 'Foo::Meta::Role', ],
 616         );
 617     }
 618 }
 619 {
 620     package Role::Baz;
 621
 622     Foo::Role->import;
 623
 624     sub bla {}
 625 }
 626 {
 627     package My::Class12;
 628
 629     use Mouse;
 630
 631     with( 'Role::Baz' );
 632 }
 633 {
 634     ok(
 635         My::Class12->meta->does_role( 'Role::Baz' ),
 636         'role applied'
 637     );
 638     my $method = My::Class12->meta->get_method( 'bla' );
 639     ok(
 640         $method->meta->does_role( 'Foo::Meta::Role' ),
 641         'method_metaclass_role applied'
 642     );
 643 }
 644
 645 {
 646     package Parent;
 647     use Mouse;
 648
 649     Mouse::Util::MetaRole::apply_metaclass_roles(
 650         for_class               => __PACKAGE__,
 651         constructor_class_roles => ['Role::Foo'],
 652     );
 653 }
 654
 655 {
 656     package Child;
 657
 658     use Mouse;
 659     extends 'Parent';
 660 }
 661
 662 {
 663     ok(
 664         Parent->meta->constructor_class->meta->can('does_role')
 665             && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
 666         'Parent constructor class has metarole from Parent'
 667     );
 668
 669 TODO:
 670     {
 671         local $TODO
 672             = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
 673         ok(
 674             Child->meta->constructor_class->meta->can('does_role')
 675                 && Child->meta->constructor_class->meta->does_role(
 676                 'Role::Foo'),
 677             'Child constructor class has metarole from Parent'
 678         );
 679     }
 680 }