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