Commit | Line | Data |
4c15a12d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
28412c0b |
6 | use Test::More tests => 40; |
4c15a12d |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Moose'); |
11 | } |
12 | |
c4538447 |
13 | { |
14 | # test no conflicts here |
15 | package Role::A; |
16 | use Moose::Role; |
4c15a12d |
17 | |
c4538447 |
18 | sub bar { 'Role::A::bar' } |
4c15a12d |
19 | |
c4538447 |
20 | package Role::B; |
21 | use Moose::Role; |
4c15a12d |
22 | |
c4538447 |
23 | sub xxy { 'Role::B::xxy' } |
4c15a12d |
24 | |
c4538447 |
25 | package Role::C; |
26 | use Moose::Role; |
27 | |
28 | ::lives_ok { |
29 | with qw(Role::A Role::B); # no conflict here |
4c15a12d |
30 | } "define role C"; |
31 | |
c4538447 |
32 | sub foo { 'Role::C::foo' } |
33 | sub zot { 'Role::C::zot' } |
4c15a12d |
34 | |
c4538447 |
35 | package Class::A; |
36 | use Moose; |
4c15a12d |
37 | |
c4538447 |
38 | ::lives_ok { |
39 | with qw(Role::C); |
4c15a12d |
40 | } "define class A"; |
c4538447 |
41 | |
42 | sub zot { 'Class::A::zot' } |
43 | } |
4c15a12d |
44 | |
c4538447 |
45 | can_ok( Class::A->new, qw(foo bar xxy zot) ); |
4c15a12d |
46 | |
c4538447 |
47 | is( Class::A->new->foo, "Role::C::foo", "... got the right foo method" ); |
48 | is( Class::A->new->zot, "Class::A::zot", "... got the right zot method" ); |
49 | is( Class::A->new->bar, "Role::A::bar", "... got the right bar method" ); |
50 | is( Class::A->new->xxy, "Role::B::xxy", "... got the right xxy method" ); |
4c15a12d |
51 | |
52 | { |
c4538447 |
53 | # check that when a role is added to another role |
54 | # and they conflict and the method they conflicted |
55 | # with is then required. |
56 | |
57 | package Role::A::Conflict; |
58 | use Moose::Role; |
59 | |
60 | with 'Role::A'; |
61 | |
62 | sub bar { 'Role::A::Conflict::bar' } |
63 | |
64 | package Class::A::Conflict; |
65 | use Moose; |
66 | |
67 | ::throws_ok { |
68 | with 'Role::A::Conflict'; |
69 | } qr/requires.*'bar'/, '... did not fufill the requirement of &bar method'; |
70 | |
71 | package Class::A::Resolved; |
72 | use Moose; |
73 | |
74 | ::lives_ok { |
75 | with 'Role::A::Conflict'; |
76 | } '... did fufill the requirement of &bar method'; |
77 | |
78 | sub bar { 'Class::A::Resolved::bar' } |
79 | } |
4c15a12d |
80 | |
c4538447 |
81 | ok(Role::A::Conflict->meta->requires_method('bar'), '... Role::A::Conflict created the bar requirement'); |
4c15a12d |
82 | |
c4538447 |
83 | can_ok( Class::A::Resolved->new, qw(bar) ); |
4c15a12d |
84 | |
c4538447 |
85 | is( Class::A::Resolved->new->bar, 'Class::A::Resolved::bar', "... got the right bar method" ); |
4c15a12d |
86 | |
c4538447 |
87 | { |
88 | # check that when two roles are composed, they conflict |
89 | # but the composing role can resolve that conflict |
90 | |
91 | package Role::D; |
92 | use Moose::Role; |
4c15a12d |
93 | |
c4538447 |
94 | sub foo { 'Role::D::foo' } |
95 | sub bar { 'Role::D::bar' } |
4c15a12d |
96 | |
c4538447 |
97 | package Role::E; |
98 | use Moose::Role; |
4c15a12d |
99 | |
c4538447 |
100 | sub foo { 'Role::E::foo' } |
101 | sub xxy { 'Role::E::xxy' } |
4c15a12d |
102 | |
c4538447 |
103 | package Role::F; |
104 | use Moose::Role; |
4c15a12d |
105 | |
c4538447 |
106 | ::lives_ok { |
107 | with qw(Role::D Role::E); # conflict between 'foo's here |
108 | } "define role Role::F"; |
109 | |
110 | sub foo { 'Role::F::foo' } |
111 | sub zot { 'Role::F::zot' } |
112 | |
113 | package Class::B; |
114 | use Moose; |
115 | |
116 | ::lives_ok { |
4c15a12d |
117 | with qw(Role::F); |
4c15a12d |
118 | } "define class Class::B"; |
c4538447 |
119 | |
120 | sub zot { 'Class::B::zot' } |
121 | } |
4c15a12d |
122 | |
c4538447 |
123 | can_ok( Class::B->new, qw(foo bar xxy zot) ); |
4c15a12d |
124 | |
c4538447 |
125 | is( Class::B->new->foo, "Role::F::foo", "... got the &foo method okay" ); |
126 | is( Class::B->new->zot, "Class::B::zot", "... got the &zot method okay" ); |
127 | is( Class::B->new->bar, "Role::D::bar", "... got the &bar method okay" ); |
128 | is( Class::B->new->xxy, "Role::E::xxy", "... got the &xxy method okay" ); |
129 | |
130 | ok(!Role::F->meta->requires_method('foo'), '... Role::F fufilled the &foo requirement'); |
131 | |
132 | { |
133 | # check that a conflict can be resolved |
134 | # by a role, but also new ones can be |
135 | # created just as easily ... |
136 | |
137 | package Role::D::And::E::Conflict; |
138 | use Moose::Role; |
139 | |
140 | ::lives_ok { |
141 | with qw(Role::D Role::E); # conflict between 'foo's here |
142 | } "... define role Role::D::And::E::Conflict"; |
143 | |
144 | sub foo { 'Role::D::And::E::Conflict::foo' } # this overrides ... |
145 | |
146 | # but these conflict |
147 | sub xxy { 'Role::D::And::E::Conflict::xxy' } |
148 | sub bar { 'Role::D::And::E::Conflict::bar' } |
4c15a12d |
149 | |
150 | } |
151 | |
c4538447 |
152 | ok(!Role::D::And::E::Conflict->meta->requires_method('foo'), '... Role::D::And::E::Conflict fufilled the &foo requirement'); |
153 | ok(Role::D::And::E::Conflict->meta->requires_method('xxy'), '... Role::D::And::E::Conflict adds the &xxy requirement'); |
154 | ok(Role::D::And::E::Conflict->meta->requires_method('bar'), '... Role::D::And::E::Conflict adds the &bar requirement'); |
155 | |
4c15a12d |
156 | { |
157 | # conflict propagation |
c4538447 |
158 | |
159 | package Role::H; |
160 | use Moose::Role; |
4c15a12d |
161 | |
c4538447 |
162 | sub foo { 'Role::H::foo' } |
163 | sub bar { 'Role::H::bar' } |
4c15a12d |
164 | |
c4538447 |
165 | package Role::J; |
166 | use Moose::Role; |
4c15a12d |
167 | |
c4538447 |
168 | sub foo { 'Role::J::foo' } |
169 | sub xxy { 'Role::J::xxy' } |
4c15a12d |
170 | |
c4538447 |
171 | package Role::I; |
172 | use Moose::Role; |
4c15a12d |
173 | |
c4538447 |
174 | ::lives_ok { |
4c15a12d |
175 | with qw(Role::J Role::H); # conflict between 'foo's here |
4c15a12d |
176 | } "define role Role::I"; |
c4538447 |
177 | |
178 | sub zot { 'Role::I::zot' } |
4c15a12d |
179 | |
c4538447 |
180 | package Class::C; |
181 | use Moose; |
182 | |
183 | ::throws_ok { |
4c15a12d |
184 | with qw(Role::I); |
4c15a12d |
185 | } qr/requires.*'foo'/, "defining class Class::C fails"; |
186 | |
c4538447 |
187 | sub zot { 'Class::C::zot' } |
4c15a12d |
188 | |
c4538447 |
189 | package Class::E; |
190 | use Moose; |
191 | |
192 | ::lives_ok { |
4c15a12d |
193 | with qw(Role::I); |
c4538447 |
194 | } "resolved with method"; |
195 | |
196 | sub foo { 'Class::E::foo' } |
197 | sub zot { 'Class::E::zot' } |
198 | } |
199 | |
200 | can_ok( Class::E->new, qw(foo bar xxy zot) ); |
4c15a12d |
201 | |
c4538447 |
202 | is( Class::E->new->foo, "Class::E::foo", "... got the right &foo method" ); |
203 | is( Class::E->new->zot, "Class::E::zot", "... got the right &zot method" ); |
204 | is( Class::E->new->bar, "Role::H::bar", "... got the right &bar method" ); |
205 | is( Class::E->new->xxy, "Role::J::xxy", "... got the right &xxy method" ); |
4c15a12d |
206 | |
c4538447 |
207 | ok(Role::I->meta->requires_method('foo'), '... Role::I still have the &foo requirement'); |
208 | |
209 | { |
fb1e11d5 |
210 | # fix these later ... |
211 | TODO: { |
c4538447 |
212 | local $TODO = "add support for attribute methods fufilling reqs"; |
fb1e11d5 |
213 | |
214 | lives_ok { |
215 | package Class::D; |
216 | use Moose; |
217 | |
218 | has foo => ( default => __PACKAGE__ . "::foo", is => "rw" ); |
219 | |
c4538447 |
220 | sub zot { 'Class::D::zot' } |
fb1e11d5 |
221 | |
222 | with qw(Role::I); |
c4538447 |
223 | |
fb1e11d5 |
224 | } "resolved with attr"; |
225 | |
226 | can_ok( Class::D->new, qw(foo bar xxy zot) ); |
227 | is( eval { Class::D->new->bar }, "Role::H::bar", "bar" ); |
228 | is( eval { Class::D->new->xxy }, "Role::I::xxy", "xxy" ); |
229 | } |
4c15a12d |
230 | |
231 | is( eval { Class::D->new->foo }, "Class::D::foo", "foo" ); |
232 | is( eval { Class::D->new->zot }, "Class::D::zot", "zot" ); |
4c15a12d |
233 | |
4c15a12d |
234 | } |
235 | |