Commit | Line | Data |
6cfa1e5e |
1 | #!/usr/bin/perl |
fde8e43f |
2 | # This is automatically generated by author/import-moose-test.pl. |
3 | # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! |
4 | use t::lib::MooseCompat; |
6cfa1e5e |
5 | |
6 | use strict; |
7 | use warnings; |
6cfa1e5e |
8 | |
6475f69d |
9 | use Test::More; |
10 | use Test::Exception; |
6cfa1e5e |
11 | |
12 | |
13 | { |
14 | # NOTE: |
15 | # this tests that repeated role |
16 | # composition will not cause |
17 | # a conflict between two methods |
18 | # which are actually the same anyway |
19 | |
20 | { |
21 | package RootA; |
22 | use Mouse::Role; |
23 | |
24 | sub foo { "RootA::foo" } |
25 | |
26 | package SubAA; |
27 | use Mouse::Role; |
28 | |
29 | with "RootA"; |
30 | |
31 | sub bar { "SubAA::bar" } |
32 | |
33 | package SubAB; |
34 | use Mouse; |
35 | |
36 | ::lives_ok { |
37 | with "SubAA", "RootA"; |
38 | } '... role was composed as expected'; |
39 | } |
40 | |
41 | ok( SubAB->does("SubAA"), "does SubAA"); |
42 | ok( SubAB->does("RootA"), "does RootA"); |
43 | |
44 | isa_ok( my $i = SubAB->new, "SubAB" ); |
45 | |
46 | can_ok( $i, "bar" ); |
47 | is( $i->bar, "SubAA::bar", "... got thr right bar rv" ); |
48 | |
49 | can_ok( $i, "foo" ); |
50 | my $foo_rv; |
51 | lives_ok { |
52 | $foo_rv = $i->foo; |
53 | } '... called foo successfully'; |
54 | is($foo_rv, "RootA::foo", "... got the right foo rv"); |
55 | } |
56 | |
57 | { |
58 | # NOTE: |
59 | # this edge cases shows the application of |
60 | # an after modifier over a method which |
61 | # was added during role composotion. |
62 | # The way this will work is as follows: |
63 | # role SubBA will consume RootB and |
64 | # get a local copy of RootB::foo, it |
65 | # will also store a deferred after modifier |
66 | # to be applied to whatever class SubBA is |
67 | # composed into. |
68 | # When class SubBB comsumed role SubBA, the |
69 | # RootB::foo method is added to SubBB, then |
70 | # the deferred after modifier from SubBA is |
71 | # applied to it. |
72 | # It is important to note that the application |
73 | # of the after modifier does not happen until |
74 | # role SubBA is composed into SubAA. |
75 | |
76 | { |
77 | package RootB; |
78 | use Mouse::Role; |
79 | |
80 | sub foo { "RootB::foo" } |
81 | |
82 | package SubBA; |
83 | use Mouse::Role; |
84 | |
85 | with "RootB"; |
86 | |
87 | has counter => ( |
88 | isa => "Num", |
89 | is => "rw", |
90 | default => 0, |
91 | ); |
92 | |
93 | after foo => sub { |
94 | $_[0]->counter( $_[0]->counter + 1 ); |
95 | }; |
96 | |
97 | package SubBB; |
98 | use Mouse; |
99 | |
100 | ::lives_ok { |
101 | with "SubBA"; |
102 | } '... composed the role successfully'; |
103 | } |
104 | |
105 | ok( SubBB->does("SubBA"), "BB does SubBA" ); |
106 | ok( SubBB->does("RootB"), "BB does RootB" ); |
107 | |
108 | isa_ok( my $i = SubBB->new, "SubBB" ); |
109 | |
110 | can_ok( $i, "foo" ); |
111 | |
112 | my $foo_rv; |
113 | lives_ok { |
114 | $foo_rv = $i->foo |
115 | } '... called foo successfully'; |
116 | is( $foo_rv, "RootB::foo", "foo rv" ); |
117 | is( $i->counter, 1, "after hook called" ); |
118 | |
119 | lives_ok { $i->foo } '... called foo successfully (again)'; |
120 | is( $i->counter, 2, "after hook called (again)" ); |
121 | |
122 | ok(SubBA->meta->has_method('foo'), '... this has the foo method'); |
123 | #my $subba_foo_rv; |
124 | #lives_ok { |
125 | # $subba_foo_rv = SubBA::foo(); |
126 | #} '... called the sub as a function correctly'; |
127 | #is($subba_foo_rv, 'RootB::foo', '... the SubBA->foo is still the RootB version'); |
128 | } |
129 | |
130 | { |
131 | # NOTE: |
132 | # this checks that an override method |
133 | # does not try to trample over a locally |
134 | # composed in method. In this case the |
135 | # RootC::foo, which is composed into |
136 | # SubCA cannot be trampled with an |
137 | # override of 'foo' |
138 | { |
139 | package RootC; |
140 | use Mouse::Role; |
141 | |
142 | sub foo { "RootC::foo" } |
143 | |
144 | package SubCA; |
145 | use Mouse::Role; |
146 | |
147 | with "RootC"; |
148 | |
149 | ::dies_ok { |
150 | override foo => sub { "overridden" }; |
151 | } '... cannot compose an override over a local method'; |
152 | } |
153 | } |
154 | |
155 | # NOTE: |
156 | # need to talk to Yuval about the motivation behind |
157 | # this test, I am not sure we are testing anything |
158 | # useful here (although more tests cant hurt) |
159 | |
160 | { |
161 | use List::Util qw/shuffle/; |
162 | |
163 | { |
164 | package Abstract; |
165 | use Mouse::Role; |
166 | |
167 | requires "method"; |
168 | requires "other"; |
169 | |
170 | sub another { "abstract" } |
171 | |
172 | package ConcreteA; |
173 | use Mouse::Role; |
174 | with "Abstract"; |
175 | |
176 | sub other { "concrete a" } |
177 | |
178 | package ConcreteB; |
179 | use Mouse::Role; |
180 | with "Abstract"; |
181 | |
182 | sub method { "concrete b" } |
183 | |
184 | package ConcreteC; |
185 | use Mouse::Role; |
186 | with "ConcreteA"; |
187 | |
188 | # NOTE: |
189 | # this was originally override, but |
190 | # that wont work (see above set of tests) |
191 | # so I switched it to around. |
192 | # However, this may not be testing the |
193 | # same thing that was originally intended |
194 | around other => sub { |
195 | return ( (shift)->() . " + c" ); |
196 | }; |
197 | |
198 | package SimpleClassWithSome; |
199 | use Mouse; |
200 | |
201 | eval { with ::shuffle qw/ConcreteA ConcreteB/ }; |
202 | ::ok( !$@, "simple composition without abstract" ) || ::diag $@; |
203 | |
204 | package SimpleClassWithAll; |
205 | use Mouse; |
206 | |
207 | eval { with ::shuffle qw/ConcreteA ConcreteB Abstract/ }; |
208 | ::ok( !$@, "simple composition with abstract" ) || ::diag $@; |
209 | } |
210 | |
211 | foreach my $class (qw/SimpleClassWithSome SimpleClassWithAll/) { |
212 | foreach my $role (qw/Abstract ConcreteA ConcreteB/) { |
213 | ok( $class->does($role), "$class does $role"); |
214 | } |
215 | |
216 | foreach my $method (qw/method other another/) { |
217 | can_ok( $class, $method ); |
218 | } |
219 | |
220 | is( eval { $class->another }, "abstract", "provided by abstract" ); |
221 | is( eval { $class->other }, "concrete a", "provided by concrete a" ); |
222 | is( eval { $class->method }, "concrete b", "provided by concrete b" ); |
223 | } |
224 | |
225 | { |
226 | package ClassWithSome; |
227 | use Mouse; |
228 | |
229 | eval { with ::shuffle qw/ConcreteC ConcreteB/ }; |
230 | ::ok( !$@, "composition without abstract" ) || ::diag $@; |
231 | |
232 | package ClassWithAll; |
233 | use Mouse; |
234 | |
235 | eval { with ::shuffle qw/ConcreteC Abstract ConcreteB/ }; |
236 | ::ok( !$@, "composition with abstract" ) || ::diag $@; |
237 | |
238 | package ClassWithEverything; |
239 | use Mouse; |
240 | |
241 | eval { with ::shuffle qw/ConcreteC Abstract ConcreteA ConcreteB/ }; # this should clash |
242 | ::ok( !$@, "can compose ConcreteA and ConcreteC together" ); |
243 | } |
244 | |
245 | foreach my $class (qw/ClassWithSome ClassWithAll ClassWithEverything/) { |
246 | foreach my $role (qw/Abstract ConcreteA ConcreteB ConcreteC/) { |
247 | ok( $class->does($role), "$class does $role"); |
248 | } |
249 | |
250 | foreach my $method (qw/method other another/) { |
251 | can_ok( $class, $method ); |
252 | } |
253 | |
254 | is( eval { $class->another }, "abstract", "provided by abstract" ); |
255 | is( eval { $class->other }, "concrete a + c", "provided by concrete c + a" ); |
256 | is( eval { $class->method }, "concrete b", "provided by concrete b" ); |
257 | } |
258 | } |
6475f69d |
259 | |
260 | done_testing; |