t/050_metaclasses/failing/016_metarole_w_metaclass_pm.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 8;
   7
   8 use Mouse::Util::MetaRole;
   9
  10 BEGIN
  11 {
  12     package My::Meta::Class;
  13     use Mouse;
  14     extends 'Mouse::Meta::Class';
  15 }
  16
  17 BEGIN
  18 {
  19     package My::Meta::Attribute;
  20     use Mouse;
  21     extends 'Mouse::Meta::Attribute';
  22 }
  23
  24 BEGIN
  25 {
  26     package My::Meta::Method;
  27     use Mouse;
  28     extends 'Mouse::Meta::Method';
  29 }
  30
  31 BEGIN
  32 {
  33     package My::Meta::Instance;
  34     use Mouse;
  35     extends 'Mouse::Meta::Instance';
  36 }
  37
  38 BEGIN
  39 {
  40     package Role::Foo;
  41     use Mouse::Role;
  42     has 'foo' => ( is => 'ro', default => 10 );
  43 }
  44
  45 {
  46     package My::Class;
  47
  48     use metaclass 'My::Meta::Class';
  49     use Mouse;
  50 }
  51
  52 {
  53     package My::Class2;
  54
  55     use metaclass 'My::Meta::Class' => (
  56         attribute_metaclass => 'My::Meta::Attribute',
  57         method_metaclass    => 'My::Meta::Method',
  58         instance_metaclass  => 'My::Meta::Instance',
  59     );
  60
  61     use Mouse;
  62 }
  63
  64 {
  65     Mouse::Util::MetaRole::apply_metaclass_roles(
  66         for_class       => 'My::Class',
  67         metaclass_roles => ['Role::Foo'],
  68     );
  69
  70     ok( My::Class->meta()->meta()->does_role('Role::Foo'),
  71         'apply Role::Foo to My::Class->meta()' );
  72     has_superclass( My::Class->meta(), 'My::Meta::Class',
  73                     'apply_metaclass_roles works with metaclass.pm' );
  74 }
  75
  76 {
  77     Mouse::Util::MetaRole::apply_metaclass_roles(
  78         for_class                 => 'My::Class2',
  79         attribute_metaclass_roles => ['Role::Foo'],
  80         method_metaclass_roles    => ['Role::Foo'],
  81         instance_metaclass_roles  => ['Role::Foo'],
  82     );
  83
  84     ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
  85         q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
  86     has_superclass( My::Class2->meta()->attribute_metaclass(), 'My::Meta::Attribute',
  87                     '... and this does not interfere with attribute metaclass set via metaclass.pm' );
  88     ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
  89         q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
  90     has_superclass( My::Class2->meta()->method_metaclass(), 'My::Meta::Method',
  91                     '... and this does not interfere with method metaclass set via metaclass.pm' );
  92     ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
  93         q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
  94     has_superclass( My::Class2->meta()->instance_metaclass(), 'My::Meta::Instance',
  95                     '... and this does not interfere with instance metaclass set via metaclass.pm' );
  96 }
  97
  98 # like isa_ok but works with a class name, not just refs
  99 sub has_superclass {
 100     my $thing  = shift;
 101     my $parent = shift;
 102     my $desc   = shift;
 103
 104     my %supers = map { $_ => 1 } $thing->meta()->superclasses();
 105
 106     local $Test::Builder::Level = $Test::Builder::Level + 1;
 107
 108     ok( $supers{$parent}, $desc );
 109 }