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 => 80;
   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         wrapped_method_metaclass_roles => ['Role::Foo'],
  82     );
  83
  84     ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'),
  85         q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} );
  86     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  87         '... My::Class->meta() still does Role::Foo' );
  88     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  89         '... My::Class->meta() still does Role::Foo' );
  90     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  91         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
  92
  93     My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } );
  94     is( My::Class->meta()->get_method('bar')->foo(), 10,
  95         '... call foo() on a wrapped method metaclass object' );
  96 }
  97
  98 {
  99     Moose::Util::MetaRole::apply_metaclass_roles(
 100         for_class              => 'My::Class',
 101         instance_metaclass_roles => ['Role::Foo'],
 102     );
 103
 104     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 105         q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
 106     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 107         '... My::Class->meta() still does Role::Foo' );
 108     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 109         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 110     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 111         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 112
 113     is( My::Class->meta()->get_meta_instance()->foo(), 10,
 114         '... call foo() on an instance metaclass object' );
 115 }
 116
 117 {
 118     Moose::Util::MetaRole::apply_metaclass_roles(
 119         for_class               => 'My::Class',
 120         constructor_class_roles => ['Role::Foo'],
 121     );
 122
 123     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 124         q{apply Role::Foo to My::Class->meta()'s constructor class} );
 125     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 126         '... My::Class->meta() still does Role::Foo' );
 127     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 128         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 129     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 130         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 131     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 132         q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 133
 134     # Actually instantiating the constructor class is too freaking hard!
 135     ok( My::Class->meta()->constructor_class()->can('foo'),
 136         '... constructor class has a foo method' );
 137 }
 138
 139 {
 140     Moose::Util::MetaRole::apply_metaclass_roles(
 141         for_class              => 'My::Class',
 142         destructor_class_roles => ['Role::Foo'],
 143     );
 144
 145     ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 146         q{apply Role::Foo to My::Class->meta()'s destructor class} );
 147     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
 148         '... My::Class->meta() still does Role::Foo' );
 149     ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 150         q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
 151     ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 152         q{... My::Class->meta()'s method metaclass still does Role::Foo} );
 153     ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 154         q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
 155     ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 156         q{... My::Class->meta()'s constructor class still does Role::Foo} );
 157
 158     # same problem as the constructor class
 159     ok( My::Class->meta()->destructor_class()->can('foo'),
 160         '... destructor class has a foo method' );
 161 }
 162
 163 {
 164     Moose::Util::MetaRole::apply_base_class_roles(
 165         for_class => 'My::Class',
 166         roles     => ['Role::Foo'],
 167     );
 168
 169     ok( My::Class->meta()->does_role('Role::Foo'),
 170         'apply Role::Foo to My::Class base class' );
 171     is( My::Class->new()->foo(), 10,
 172         '... call foo() on a My::Class object' );
 173 }
 174
 175 {
 176     package My::Class2;
 177
 178     use Moose;
 179 }
 180
 181 {
 182     Moose::Util::MetaRole::apply_metaclass_roles(
 183         for_class                 => 'My::Class2',
 184         metaclass_roles           => ['Role::Foo'],
 185         attribute_metaclass_roles => ['Role::Foo'],
 186         method_metaclass_roles    => ['Role::Foo'],
 187         instance_metaclass_roles  => ['Role::Foo'],
 188         constructor_class_roles   => ['Role::Foo'],
 189         destructor_class_roles    => ['Role::Foo'],
 190     );
 191
 192     ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
 193         'apply Role::Foo to My::Class2->meta()' );
 194     is( My::Class2->meta()->foo(), 10,
 195         '... and call foo() on that meta object' );
 196     ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 197         q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
 198     My::Class2->meta()->add_attribute( 'size', is => 'ro' );
 199
 200     is( My::Class2->meta()->get_attribute('size')->foo(), 10,
 201         '... call foo() on an attribute metaclass object' );
 202
 203     ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 204         q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
 205
 206     My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
 207     is( My::Class2->meta()->get_method('bar')->foo(), 10,
 208         '... call foo() on a method metaclass object' );
 209
 210     ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 211         q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
 212     is( My::Class2->meta()->get_meta_instance()->foo(), 10,
 213         '... call foo() on an instance metaclass object' );
 214
 215     ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 216         q{apply Role::Foo to My::Class2->meta()'s constructor class} );
 217     ok( My::Class2->meta()->constructor_class()->can('foo'),
 218         '... constructor class has a foo method' );
 219
 220     ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 221         q{apply Role::Foo to My::Class2->meta()'s destructor class} );
 222     ok( My::Class2->meta()->destructor_class()->can('foo'),
 223         '... destructor class has a foo method' );
 224 }
 225
 226
 227 {
 228     package My::Meta;
 229
 230     use Moose::Exporter;
 231     Moose::Exporter->setup_import_methods( also => 'Moose' );
 232
 233     sub init_meta {
 234         shift;
 235         my %p = @_;
 236
 237         Moose->init_meta( %p, metaclass => 'My::Meta::Class' );
 238     }
 239 }
 240
 241 {
 242     package My::Class3;
 243
 244     My::Meta->import();
 245 }
 246
 247
 248 {
 249     Moose::Util::MetaRole::apply_metaclass_roles(
 250         for_class                 => 'My::Class3',
 251         metaclass_roles           => ['Role::Foo'],
 252     );
 253
 254     ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
 255         'apply Role::Foo to My::Class3->meta()' );
 256     is( My::Class3->meta()->foo(), 10,
 257         '... and call foo() on that meta object' );
 258     ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
 259         'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' );
 260 }
 261
 262 {
 263     package Role::Bar;
 264     use Moose::Role;
 265     has 'bar' => ( is => 'ro', default => 200 );
 266 }
 267
 268 {
 269     package My::Class4;
 270     use Moose;
 271 }
 272
 273 {
 274     Moose::Util::MetaRole::apply_metaclass_roles(
 275         for_class                 => 'My::Class4',
 276         metaclass_roles           => ['Role::Foo'],
 277     );
 278
 279     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 280         'apply Role::Foo to My::Class4->meta()' );
 281
 282     Moose::Util::MetaRole::apply_metaclass_roles(
 283         for_class                 => 'My::Class4',
 284         metaclass_roles           => ['Role::Bar'],
 285     );
 286
 287     ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
 288         'apply Role::Bar to My::Class4->meta()' );
 289     ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
 290         '... and My::Class4->meta() still does Role::Foo' );
 291 }
 292
 293 {
 294     package My::Class5;
 295     use Moose;
 296
 297     extends 'My::Class';
 298 }
 299
 300 {
 301     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 302         q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
 303     ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
 304         q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
 305     ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
 306         q{My::Class5->meta()'s method metaclass also does Role::Foo} );
 307     ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
 308         q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
 309     ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
 310         q{My::Class5->meta()'s constructor class also does Role::Foo} );
 311     ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
 312         q{My::Class5->meta()'s destructor class also does Role::Foo} );
 313 }
 314
 315 {
 316     Moose::Util::MetaRole::apply_metaclass_roles(
 317         for_class       => 'My::Class5',
 318         metaclass_roles => ['Role::Bar'],
 319     );
 320
 321     ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
 322         q{apply Role::Bar My::Class5->meta()} );
 323     ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
 324         q{... and My::Class5->meta() still does Role::Foo} );
 325 }
 326
 327 {
 328     package My::Class6;
 329     use Moose;
 330
 331     Moose::Util::MetaRole::apply_metaclass_roles(
 332         for_class       => 'My::Class6',
 333         metaclass_roles => ['Role::Bar'],
 334     );
 335
 336     extends 'My::Class';
 337 }
 338
 339 {
 340     ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
 341         q{apply Role::Bar My::Class6->meta() before extends} );
 342     ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
 343         q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
 344 }
 345
 346 # This is the hack that used to be needed to work around the
 347 # _fix_metaclass_incompatibility problem. You called extends() (which
 348 # in turn calls _fix_metaclass_imcompatibility) _before_ you apply
 349 # more extensions in the subclass. We wabt to make sure this continues
 350 # to work in the future.
 351 {
 352     package My::Class7;
 353     use Moose;
 354
 355     # In real usage this would go in a BEGIN block so it happened
 356     # before apply_metaclass_roles was called by an extension.
 357     extends 'My::Class';
 358
 359     Moose::Util::MetaRole::apply_metaclass_roles(
 360         for_class       => 'My::Class7',
 361         metaclass_roles => ['Role::Bar'],
 362     );
 363 }
 364
 365 {
 366     ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
 367         q{apply Role::Bar My::Class7->meta() before extends} );
 368     ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
 369         q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
 370 }
 371
 372 {
 373     package My::Class8;
 374     use Moose;
 375
 376     Moose::Util::MetaRole::apply_metaclass_roles(
 377         for_class                 => 'My::Class8',
 378         metaclass_roles           => ['Role::Bar'],
 379         attribute_metaclass_roles => ['Role::Bar'],
 380     );
 381
 382     extends 'My::Class';
 383 }
 384
 385 {
 386     ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
 387         q{apply Role::Bar My::Class8->meta() before extends} );
 388     ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
 389         q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
 390     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 391         q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
 392     ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 393         q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
 394 }
 395
 396
 397 {
 398     package My::Class9;
 399     use Moose;
 400
 401     Moose::Util::MetaRole::apply_metaclass_roles(
 402         for_class                 => 'My::Class9',
 403         attribute_metaclass_roles => ['Role::Bar'],
 404     );
 405
 406     extends 'My::Class';
 407 }
 408
 409 {
 410     ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
 411         q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
 412     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
 413         q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
 414     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
 415         q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
 416 }
 417
 418 # This tests applying meta roles to a metaclass's metaclass. This is
 419 # completely insane, but is exactly what happens with
 420 # Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class
 421 # itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass
 422 # for Fey::Meta::Class::Table does a role.
 423 #
 424 # At one point this caused a metaclass incompatibility error down
 425 # below, when we applied roles to the metaclass of My::Class10. It's
 426 # all madness but as long as the tests pass we're happy.
 427 {
 428     package My::Meta::Class2;
 429     use Moose;
 430     extends 'Moose::Meta::Class';
 431
 432     Moose::Util::MetaRole::apply_metaclass_roles(
 433         for_class       => 'My::Meta::Class2',
 434         metaclass_roles => ['Role::Foo'],
 435     );
 436 }
 437
 438 {
 439     package My::Object;
 440     use Moose;
 441     extends 'Moose::Object';
 442 }
 443
 444 {
 445     package My::Meta2;
 446
 447     use Moose::Exporter;
 448     Moose::Exporter->setup_import_methods( also => 'Moose' );
 449
 450     sub init_meta {
 451         shift;
 452         my %p = @_;
 453
 454         Moose->init_meta(
 455             %p,
 456             metaclass  => 'My::Meta::Class2',
 457             base_class => 'My::Object',
 458         );
 459     }
 460 }
 461
 462 {
 463     package My::Class10;
 464     My::Meta2->import;
 465
 466     Moose::Util::MetaRole::apply_metaclass_roles(
 467         for_class       => 'My::Class10',
 468         metaclass_roles => ['Role::Bar'],
 469     );
 470 }
 471
 472 {
 473     ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
 474         q{My::Class10->meta()->meta() does Role::Foo } );
 475     ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
 476         q{My::Class10->meta()->meta() does Role::Bar } );
 477     ok( My::Class10->meta()->isa('My::Meta::Class2'),
 478         q{... and My::Class10->meta still isa(My::Meta::Class2)} );
 479     ok( My::Class10->isa('My::Object'),
 480         q{... and My::Class10 still isa(My::Object)} );
 481 }
 482
 483 {
 484     package My::Constructor;
 485
 486     use base 'Moose::Meta::Method::Constructor';
 487 }
 488
 489 {
 490     package My::Class11;
 491
 492     use Moose;
 493
 494     __PACKAGE__->meta->constructor_class('My::Constructor');
 495
 496     Moose::Util::MetaRole::apply_metaclass_roles(
 497         for_class       => 'My::Class11',
 498         metaclass_roles => ['Role::Foo'],
 499     );
 500 }
 501
 502 {
 503     ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
 504         q{My::Class11->meta()->meta() does Role::Foo } );
 505     is( My::Class11->meta()->constructor_class, 'My::Constructor',
 506         q{... and explicitly set constructor_class value is unchanged)} );
 507 }
 508
 509 {
 510     package ExportsMoose;
 511
 512     Moose::Exporter->setup_import_methods(
 513         also        => 'Moose',
 514     );
 515
 516     sub init_meta {
 517         shift;
 518         my %p = @_;
 519         Moose->init_meta(%p);
 520         return Moose::Util::MetaRole::apply_metaclass_roles(
 521             for_class       => $p{for_class},
 522             # Causes us to recurse through init_meta, as we have to
 523             # load MyMetaclassRole from disk.
 524            metaclass_roles => [qw/MyMetaclassRole/],
 525         );
 526     }
 527 }
 528
 529 lives_ok {
 530     package UsesExportedMoose;
 531     ExportsMoose->import;
 532 } 'import module which loads a role from disk during init_meta';
 533
 534 {
 535     package Foo::Meta::Role;
 536
 537     use Moose::Role;
 538 }
 539 {
 540     package Foo::Role;
 541
 542     Moose::Exporter->setup_import_methods(
 543         also        => 'Moose::Role',
 544     );
 545
 546     sub init_meta {
 547         shift;
 548         my %p = @_;
 549         Moose::Role->init_meta(%p);
 550         return Moose::Util::MetaRole::apply_metaclass_roles(
 551             for_class              => $p{for_class},
 552             method_metaclass_roles => [ 'Foo::Meta::Role', ],
 553         );
 554     }
 555 }
 556 {
 557     package Role::Baz;
 558
 559     Foo::Role->import;
 560
 561     sub bla {}
 562 }
 563 {
 564     package My::Class12;
 565
 566     use Moose;
 567
 568     with( 'Role::Baz' );
 569 }
 570 {
 571     ok(
 572         My::Class12->meta->does_role( 'Role::Baz' ),
 573         'role applied'
 574     );
 575     my $method = My::Class12->meta->get_method( 'bla' );
 576     ok(
 577         $method->meta->does_role( 'Foo::Meta::Role' ),
 578         'method_metaclass_role applied'
 579     );
 580 }