Commit | Line | Data |
0558683c |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
825a80de |
6 | use Test::More tests => 18; |
0558683c |
7 | use Test::Exception; |
8 | |
1db8ecc7 |
9 | =pod |
10 | |
11 | NOTE: |
12 | A fair amount of these tests will likely be irrelevant |
13 | once we have more fine grained control over the class |
14 | building process. A lot of the edge cases tested here |
15 | are actually related to class construction order and |
16 | not any real functionality. |
17 | - SL |
18 | |
19 | =cut |
20 | |
0558683c |
21 | BEGIN { |
22 | use_ok('Moose'); |
23 | use_ok('Moose::Role'); |
24 | } |
25 | |
26 | =pod |
27 | |
28 | Role which requires a method implemented |
29 | in another role as an override (it does |
30 | not remove the requirement) |
31 | |
32 | =cut |
33 | |
34 | { |
35 | package Role::RequireFoo; |
36 | use strict; |
37 | use warnings; |
38 | use Moose::Role; |
39 | |
40 | requires 'foo'; |
41 | |
42 | package Role::ProvideFoo; |
43 | use strict; |
44 | use warnings; |
45 | use Moose::Role; |
46 | |
47 | ::lives_ok { |
48 | with 'Role::RequireFoo'; |
49 | } '... the required "foo" method will not exist yet (but we will live)'; |
50 | |
51 | override 'foo' => sub { 'Role::ProvideFoo::foo' }; |
52 | } |
53 | |
54 | is_deeply( |
55 | [ Role::ProvideFoo->meta->get_required_method_list ], |
56 | [ 'foo' ], |
57 | '... foo method is still required for Role::ProvideFoo'); |
58 | |
59 | =pod |
60 | |
61 | Role which requires a method implemented |
62 | in the consuming class as an override. |
63 | It will fail since method modifiers are |
64 | second class citizens. |
65 | |
66 | =cut |
67 | |
68 | { |
69 | package Class::ProvideFoo::Base; |
70 | use Moose; |
71 | |
72 | sub foo { 'Class::ProvideFoo::Base::foo' } |
73 | |
74 | package Class::ProvideFoo::Override1; |
75 | use Moose; |
76 | |
77 | extends 'Class::ProvideFoo::Base'; |
78 | |
1db8ecc7 |
79 | ::lives_ok { |
0558683c |
80 | with 'Role::RequireFoo'; |
1db8ecc7 |
81 | } '... the required "foo" method will be found in the superclass'; |
0558683c |
82 | |
83 | override 'foo' => sub { 'Class::ProvideFoo::foo' }; |
84 | |
85 | package Class::ProvideFoo::Override2; |
86 | use Moose; |
87 | |
88 | extends 'Class::ProvideFoo::Base'; |
89 | |
90 | override 'foo' => sub { 'Class::ProvideFoo::foo' }; |
91 | |
92 | ::dies_ok { |
93 | with 'Role::RequireFoo'; |
94 | } '... the required "foo" method exists, but it is an override (and we will die)'; |
95 | |
96 | } |
97 | |
98 | =pod |
99 | |
100 | Now same thing, but with a before |
101 | method modifier. |
102 | |
103 | =cut |
104 | |
105 | { |
106 | package Class::ProvideFoo::Before1; |
107 | use Moose; |
108 | |
109 | extends 'Class::ProvideFoo::Base'; |
110 | |
1db8ecc7 |
111 | ::lives_ok { |
0558683c |
112 | with 'Role::RequireFoo'; |
1db8ecc7 |
113 | } '... the required "foo" method will be found in the superclass'; |
0558683c |
114 | |
115 | before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; |
116 | |
117 | package Class::ProvideFoo::Before2; |
118 | use Moose; |
119 | |
120 | extends 'Class::ProvideFoo::Base'; |
121 | |
122 | before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; |
123 | |
124 | ::dies_ok { |
125 | with 'Role::RequireFoo'; |
126 | } '... the required "foo" method exists, but it is a before (and we will die)'; |
127 | |
128 | package Class::ProvideFoo::Before3; |
129 | use Moose; |
130 | |
131 | extends 'Class::ProvideFoo::Base'; |
132 | |
133 | ::lives_ok { |
134 | with 'Role::RequireFoo'; |
135 | } '... the required "foo" method will not exist yet (and we will die)'; |
136 | |
137 | sub foo { 'Class::ProvideFoo::foo' } |
138 | before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; |
139 | |
140 | package Class::ProvideFoo::Before4; |
141 | use Moose; |
142 | |
143 | extends 'Class::ProvideFoo::Base'; |
144 | |
145 | sub foo { 'Class::ProvideFoo::foo' } |
146 | before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; |
147 | |
148 | ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); |
149 | ::is(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__, |
150 | '... but the original method is from our package'); |
151 | |
152 | ::lives_ok { |
153 | with 'Role::RequireFoo'; |
154 | } '... the required "foo" method exists in the symbol table (and we will live)'; |
155 | |
156 | package Class::ProvideFoo::Before5; |
157 | use Moose; |
158 | |
159 | extends 'Class::ProvideFoo::Base'; |
160 | |
161 | before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; |
162 | |
163 | ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); |
164 | ::isnt(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__, |
165 | '... but the original method is not from our package'); |
166 | |
167 | ::dies_ok { |
168 | with 'Role::RequireFoo'; |
169 | } '... the required "foo" method exists, but it is a before wrapping the super (and we will die)'; |
170 | } |
171 | |
172 | =pod |
173 | |
174 | Now same thing, but with a method from an attribute |
175 | method modifier. |
176 | |
177 | =cut |
178 | |
179 | { |
180 | |
181 | package Class::ProvideFoo::Attr1; |
182 | use Moose; |
183 | |
184 | extends 'Class::ProvideFoo::Base'; |
185 | |
1db8ecc7 |
186 | ::lives_ok { |
0558683c |
187 | with 'Role::RequireFoo'; |
1db8ecc7 |
188 | } '... the required "foo" method will be found in the superclass (but then overriden)'; |
0558683c |
189 | |
190 | has 'foo' => (is => 'ro'); |
191 | |
192 | package Class::ProvideFoo::Attr2; |
193 | use Moose; |
194 | |
195 | extends 'Class::ProvideFoo::Base'; |
196 | |
197 | has 'foo' => (is => 'ro'); |
198 | |
199 | ::dies_ok { |
200 | with 'Role::RequireFoo'; |
201 | } '... the required "foo" method exists, but it is a before (and we will die)'; |
202 | } |
825a80de |
203 | |
204 | # ... |
205 | # a method required in a role, but then |
206 | # implemented in the superclass (as an |
207 | # attribute accessor too) |
208 | |
209 | { |
210 | package Foo::Class::Base; |
211 | use Moose; |
212 | |
213 | has 'bar' => ( |
214 | isa => 'Int', |
215 | is => 'rw', |
216 | default => sub { 1 } |
217 | ); |
218 | } |
219 | { |
220 | package Foo::Role; |
221 | use Moose::Role; |
222 | |
223 | requires 'bar'; |
0558683c |
224 | |
825a80de |
225 | has 'foo' => ( |
226 | isa => 'Int', |
227 | is => 'rw', |
228 | lazy => 1, |
229 | default => sub { (shift)->bar + 1 } |
230 | ); |
231 | } |
232 | { |
233 | package Foo::Class::Child; |
234 | use Moose; |
235 | extends 'Foo::Class::Base'; |
236 | |
237 | ::dies_ok { |
238 | with 'Foo::Role'; |
239 | } '... our role combined successfully'; |
240 | } |
241 | |
242 | |
243 | |