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 {
 353     package My::Class5;
 354     use Mouse;
 355
 356     extends 'My::Class';
 357 }
 358
 359 exit(0);
 360
 361 {
 362     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 363         q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
 364     ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 365         q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
 366     ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 367         q{My::Class5->meta()'s method metaclass also does Role::Foo} );
 368     ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 369         q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
 370     ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 371         q{My::Class5->meta()'s constructor class also does Role::Foo} );
 372     ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 373         q{My::Class5->meta()'s destructor class also does Role::Foo} );
 374 }
 375
 376 {
 377     Mouse::Util::MetaRole::apply_metaclass_roles(
 378         for_class       => 'My::Class5',
 379         metaclass_roles => ['Role::Bar'],
 380     );
 381
 382     ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
 383         q{apply Role::Bar My::Class5->meta()} );
 384     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 385         q{... and My::Class5->meta() still does Role::Foo} );
 386 }
 387
 388 {
 389     package My::Class6;
 390     use Mouse;
 391
 392     Mouse::Util::MetaRole::apply_metaclass_roles(
 393         for_class       => 'My::Class6',
 394         metaclass_roles => ['Role::Bar'],
 395     );
 396
 397     extends 'My::Class';
 398 }
 399
 400 {
 401     ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
 402         q{apply Role::Bar My::Class6->meta() before extends} );
 403     ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
 404         q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
 405 }
 406
 407 # This is the hack that used to be needed to work around the
 408 # _fix_metaclass_incompatibility problem. You called extends() (which
 409 # in turn calls _fix_metaclass_imcompatibility) _before_ you apply
 410 # more extensions in the subclass. We wabt to make sure this continues
 411 # to work in the future.
 412 {
 413     package My::Class7;
 414     use Mouse;
 415
 416     # In real usage this would go in a BEGIN block so it happened
 417     # before apply_metaclass_roles was called by an extension.
 418     extends 'My::Class';
 419
 420     Mouse::Util::MetaRole::apply_metaclass_roles(
 421         for_class       => 'My::Class7',
 422         metaclass_roles => ['Role::Bar'],
 423     );
 424 }
 425
 426 {
 427     ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
 428         q{apply Role::Bar My::Class7->meta() before extends} );
 429     ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
 430         q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
 431 }
 432
 433 {
 434     package My::Class8;
 435     use Mouse;
 436
 437     Mouse::Util::MetaRole::apply_metaclass_roles(
 438         for_class                 => 'My::Class8',
 439         metaclass_roles           => ['Role::Bar'],
 440         attribute_metaclass_roles => ['Role::Bar'],
 441     );
 442
 443     extends 'My::Class';
 444 }
 445
 446 {
 447     ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
 448         q{apply Role::Bar My::Class8->meta() before extends} );
 449     ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
 450         q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
 451     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 452         q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
 453     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 454         q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
 455 }
 456
 457
 458 {
 459     package My::Class9;
 460     use Mouse;
 461
 462     Mouse::Util::MetaRole::apply_metaclass_roles(
 463         for_class                 => 'My::Class9',
 464         attribute_metaclass_roles => ['Role::Bar'],
 465     );
 466
 467     extends 'My::Class';
 468 }
 469
 470 {
 471     ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
 472         q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
 473     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 474         q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
 475     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 476         q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
 477 }
 478
 479 # This tests applying meta roles to a metaclass's metaclass. This is
 480 # completely insane, but is exactly what happens with
 481 # Fey::Meta::Class::Table. It's a subclass of Mouse::Meta::Class
 482 # itself, and then it _uses_ MouseX::ClassAttribute, so the metaclass
 483 # for Fey::Meta::Class::Table does a role.
 484 #
 485 # At one point this caused a metaclass incompatibility error down
 486 # below, when we applied roles to the metaclass of My::Class10. It's
 487 # all madness but as long as the tests pass we're happy.
 488 {
 489     package My::Meta::Class2;
 490     use Mouse;
 491     extends 'Mouse::Meta::Class';
 492
 493     Mouse::Util::MetaRole::apply_metaclass_roles(
 494         for_class       => 'My::Meta::Class2',
 495         metaclass_roles => ['Role::Foo'],
 496     );
 497 }
 498
 499 {
 500     package My::Object;
 501     use Mouse;
 502     extends 'Mouse::Object';
 503 }
 504
 505 {
 506     package My::Meta2;
 507
 508     use Mouse::Exporter;
 509     Mouse::Exporter->setup_import_methods( also => 'Mouse' );
 510
 511     sub init_meta {
 512         shift;
 513         my %p = @_;
 514
 515         Mouse->init_meta(
 516             %p,
 517             metaclass  => 'My::Meta::Class2',
 518             base_class => 'My::Object',
 519         );
 520     }
 521 }
 522
 523 {
 524     package My::Class10;
 525     My::Meta2->import;
 526
 527     Mouse::Util::MetaRole::apply_metaclass_roles(
 528         for_class       => 'My::Class10',
 529         metaclass_roles => ['Role::Bar'],
 530     );
 531 }
 532
 533 {
 534     ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
 535         q{My::Class10->meta()->meta() does Role::Foo } );
 536     ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
 537         q{My::Class10->meta()->meta() does Role::Bar } );
 538     ok( My::Class10->meta()->isa('My::Meta::Class2'),
 539         q{... and My::Class10->meta still isa(My::Meta::Class2)} );
 540     ok( My::Class10->isa('My::Object'),
 541         q{... and My::Class10 still isa(My::Object)} );
 542 }
 543
 544 {
 545     package My::Constructor;
 546
 547     use base 'Mouse::Meta::Method::Constructor';
 548 }
 549
 550 {
 551     package My::Class11;
 552
 553     use Mouse;
 554
 555     __PACKAGE__->meta->constructor_class('My::Constructor');
 556
 557     Mouse::Util::MetaRole::apply_metaclass_roles(
 558         for_class       => 'My::Class11',
 559         metaclass_roles => ['Role::Foo'],
 560     );
 561 }
 562
 563 {
 564     ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
 565         q{My::Class11->meta()->meta() does Role::Foo } );
 566     is( My::Class11->meta()->constructor_class, 'My::Constructor',
 567         q{... and explicitly set constructor_class value is unchanged)} );
 568 }
 569
 570 {
 571     package ExportsMouse;
 572
 573     Mouse::Exporter->setup_import_methods(
 574         also        => 'Mouse',
 575     );
 576
 577     sub init_meta {
 578         shift;
 579         my %p = @_;
 580         Mouse->init_meta(%p);
 581         return Mouse::Util::MetaRole::apply_metaclass_roles(
 582             for_class       => $p{for_class},
 583             # Causes us to recurse through init_meta, as we have to
 584             # load MyMetaclassRole from disk.
 585            metaclass_roles => [qw/MyMetaclassRole/],
 586         );
 587     }
 588 }
 589
 590 lives_ok {
 591     package UsesExportedMouse;
 592     ExportsMouse->import;
 593 } 'import module which loads a role from disk during init_meta';
 594
 595 {
 596     package Foo::Meta::Role;
 597
 598     use Mouse::Role;
 599 }
 600 {
 601     package Foo::Role;
 602
 603     Mouse::Exporter->setup_import_methods(
 604         also        => 'Mouse::Role',
 605     );
 606
 607     sub init_meta {
 608         shift;
 609         my %p = @_;
 610         Mouse::Role->init_meta(%p);
 611         return Mouse::Util::MetaRole::apply_metaclass_roles(
 612             for_class              => $p{for_class},
 613             method_metaclass_roles => [ 'Foo::Meta::Role', ],
 614         );
 615     }
 616 }
 617 {
 618     package Role::Baz;
 619
 620     Foo::Role->import;
 621
 622     sub bla {}
 623 }
 624 {
 625     package My::Class12;
 626
 627     use Mouse;
 628
 629     with( 'Role::Baz' );
 630 }
 631 {
 632     ok(
 633         My::Class12->meta->does_role( 'Role::Baz' ),
 634         'role applied'
 635     );
 636     my $method = My::Class12->meta->get_method( 'bla' );
 637     ok(
 638         $method->meta->does_role( 'Foo::Meta::Role' ),
 639         'method_metaclass_role applied'
 640     );
 641 }
 642
 643 {
 644     package Parent;
 645     use Mouse;
 646
 647     Mouse::Util::MetaRole::apply_metaclass_roles(
 648         for_class               => __PACKAGE__,
 649         constructor_class_roles => ['Role::Foo'],
 650     );
 651 }
 652
 653 {
 654     package Child;
 655
 656     use Mouse;
 657     extends 'Parent';
 658 }
 659
 660 {
 661     ok(
 662         Parent->meta->constructor_class->meta->can('does_role')
 663             && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
 664         'Parent constructor class has metarole from Parent'
 665     );
 666
 667 TODO:
 668     {
 669         local $TODO
 670             = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
 671         ok(
 672             Child->meta->constructor_class->meta->can('does_role')
 673                 && Child->meta->constructor_class->meta->does_role(
 674                 'Role::Foo'),
 675             'Child constructor class has metarole from Parent'
 676         );
 677     }
 678 }