diff options
Diffstat (limited to 't/metaclasses/metarole_w_metaclass_pm.t')
-rw-r--r-- | t/metaclasses/metarole_w_metaclass_pm.t | 111 |
1 files changed, 111 insertions, 0 deletions
diff --git a/t/metaclasses/metarole_w_metaclass_pm.t b/t/metaclasses/metarole_w_metaclass_pm.t new file mode 100644 index 0000000..c47a208 --- /dev/null +++ b/t/metaclasses/metarole_w_metaclass_pm.t @@ -0,0 +1,111 @@ +use strict; +use warnings; + +use Test::More; + +use Moose::Util::MetaRole; + +BEGIN +{ + package My::Meta::Class; + use Moose; + extends 'Moose::Meta::Class'; +} + +BEGIN +{ + package My::Meta::Attribute; + use Moose; + extends 'Moose::Meta::Attribute'; +} + +BEGIN +{ + package My::Meta::Method; + use Moose; + extends 'Moose::Meta::Method'; +} + +BEGIN +{ + package My::Meta::Instance; + use Moose; + extends 'Moose::Meta::Instance'; +} + +BEGIN +{ + package Role::Foo; + use Moose::Role; + has 'foo' => ( is => 'ro', default => 10 ); +} + +{ + package My::Class; + + use metaclass 'My::Meta::Class'; + use Moose; +} + +{ + package My::Class2; + + use metaclass 'My::Meta::Class' => ( + attribute_metaclass => 'My::Meta::Attribute', + method_metaclass => 'My::Meta::Method', + instance_metaclass => 'My::Meta::Instance', + ); + + use Moose; +} + +{ + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { class => ['Role::Foo'] }, + ); + + ok( My::Class->meta()->meta()->does_role('Role::Foo'), + 'apply Role::Foo to My::Class->meta()' ); + has_superclass( My::Class->meta(), 'My::Meta::Class', + 'apply_metaroles works with metaclass.pm' ); +} + +{ + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class2', + class_metaroles => { + attribute => ['Role::Foo'], + method => ['Role::Foo'], + instance => ['Role::Foo'], + }, + ); + + ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), + q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} ); + has_superclass( My::Class2->meta()->attribute_metaclass(), 'My::Meta::Attribute', + '... and this does not interfere with attribute metaclass set via metaclass.pm' ); + ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'), + q{apply Role::Foo to My::Class2->meta()'s method metaclass} ); + has_superclass( My::Class2->meta()->method_metaclass(), 'My::Meta::Method', + '... and this does not interfere with method metaclass set via metaclass.pm' ); + ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); + has_superclass( My::Class2->meta()->instance_metaclass(), 'My::Meta::Instance', + '... and this does not interfere with instance metaclass set via metaclass.pm' ); +} + +# like isa_ok but works with a class name, not just refs +sub has_superclass { + my $thing = shift; + my $parent = shift; + my $desc = shift; + + my %supers = map { $_ => 1 } $thing->meta()->superclasses(); + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + ok( $supers{$parent}, $desc ); +} + +done_testing; |