Commit | Line | Data |
67199842 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 32; |
7 | use Test::Exception; |
8 | |
c9313657 |
9 | use lib 't/lib'; |
10 | use Test::Mouse; |
11 | |
67199842 |
12 | =pod |
13 | |
6cfa1e5e |
14 | Check for repeated inheritance causing |
15 | a method conflict (which is not really |
67199842 |
16 | a conflict) |
17 | |
18 | =cut |
19 | |
20 | { |
21 | package Role::Base; |
22 | use Mouse::Role; |
6cfa1e5e |
23 | |
67199842 |
24 | sub foo { 'Role::Base::foo' } |
6cfa1e5e |
25 | |
67199842 |
26 | package Role::Derived1; |
6cfa1e5e |
27 | use Mouse::Role; |
28 | |
67199842 |
29 | with 'Role::Base'; |
6cfa1e5e |
30 | |
67199842 |
31 | package Role::Derived2; |
6cfa1e5e |
32 | use Mouse::Role; |
67199842 |
33 | |
34 | with 'Role::Base'; |
6cfa1e5e |
35 | |
67199842 |
36 | package My::Test::Class1; |
6cfa1e5e |
37 | use Mouse; |
38 | |
67199842 |
39 | ::lives_ok { |
6cfa1e5e |
40 | with 'Role::Derived1', 'Role::Derived2'; |
67199842 |
41 | } '... roles composed okay (no conflicts)'; |
42 | } |
43 | |
44 | ok(Role::Base->meta->has_method('foo'), '... have the method foo as expected'); |
45 | ok(Role::Derived1->meta->has_method('foo'), '... have the method foo as expected'); |
46 | ok(Role::Derived2->meta->has_method('foo'), '... have the method foo as expected'); |
47 | ok(My::Test::Class1->meta->has_method('foo'), '... have the method foo as expected'); |
48 | |
49 | is(My::Test::Class1->foo, 'Role::Base::foo', '... got the right value from method'); |
50 | |
51 | =pod |
52 | |
6cfa1e5e |
53 | Check for repeated inheritance causing |
54 | a method conflict with method modifiers |
67199842 |
55 | (which is not really a conflict) |
56 | |
57 | =cut |
58 | |
59 | { |
60 | package Role::Base2; |
61 | use Mouse::Role; |
6cfa1e5e |
62 | |
67199842 |
63 | override 'foo' => sub { super() . ' -> Role::Base::foo' }; |
6cfa1e5e |
64 | |
67199842 |
65 | package Role::Derived3; |
6cfa1e5e |
66 | use Mouse::Role; |
67 | |
67199842 |
68 | with 'Role::Base2'; |
6cfa1e5e |
69 | |
67199842 |
70 | package Role::Derived4; |
6cfa1e5e |
71 | use Mouse::Role; |
67199842 |
72 | |
73 | with 'Role::Base2'; |
74 | |
75 | package My::Test::Class2::Base; |
76 | use Mouse; |
6cfa1e5e |
77 | |
67199842 |
78 | sub foo { 'My::Test::Class2::Base' } |
6cfa1e5e |
79 | |
67199842 |
80 | package My::Test::Class2; |
6cfa1e5e |
81 | use Mouse; |
82 | |
83 | extends 'My::Test::Class2::Base'; |
84 | |
67199842 |
85 | ::lives_ok { |
6cfa1e5e |
86 | with 'Role::Derived3', 'Role::Derived4'; |
67199842 |
87 | } '... roles composed okay (no conflicts)'; |
88 | } |
89 | |
90 | ok(Role::Base2->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); |
91 | ok(Role::Derived3->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); |
92 | ok(Role::Derived4->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); |
93 | ok(My::Test::Class2->meta->has_method('foo'), '... have the method foo as expected'); |
6fea087b |
94 | { |
95 | local $TODO = 'Not a Mouse::Meta::Method::Overriden'; |
67199842 |
96 | isa_ok(My::Test::Class2->meta->get_method('foo'), 'Mouse::Meta::Method::Overridden'); |
6fea087b |
97 | } |
67199842 |
98 | ok(My::Test::Class2::Base->meta->has_method('foo'), '... have the method foo as expected'); |
6fea087b |
99 | { |
100 | local $TODO = 'Not a Class::MOP::Method'; |
67199842 |
101 | isa_ok(My::Test::Class2::Base->meta->get_method('foo'), 'Class::MOP::Method'); |
6fea087b |
102 | } |
67199842 |
103 | is(My::Test::Class2::Base->foo, 'My::Test::Class2::Base', '... got the right value from method'); |
104 | is(My::Test::Class2->foo, 'My::Test::Class2::Base -> Role::Base::foo', '... got the right value from method'); |
105 | |
106 | =pod |
107 | |
6cfa1e5e |
108 | Check for repeated inheritance of the |
109 | same code. There are no conflicts with |
67199842 |
110 | before/around/after method modifiers. |
111 | |
6cfa1e5e |
112 | This tests around, but should work the |
67199842 |
113 | same for before/afters as well |
114 | |
115 | =cut |
116 | |
117 | { |
118 | package Role::Base3; |
119 | use Mouse::Role; |
6cfa1e5e |
120 | |
67199842 |
121 | around 'foo' => sub { 'Role::Base::foo(' . (shift)->() . ')' }; |
6cfa1e5e |
122 | |
67199842 |
123 | package Role::Derived5; |
6cfa1e5e |
124 | use Mouse::Role; |
125 | |
67199842 |
126 | with 'Role::Base3'; |
6cfa1e5e |
127 | |
67199842 |
128 | package Role::Derived6; |
6cfa1e5e |
129 | use Mouse::Role; |
67199842 |
130 | |
131 | with 'Role::Base3'; |
132 | |
133 | package My::Test::Class3::Base; |
134 | use Mouse; |
6cfa1e5e |
135 | |
67199842 |
136 | sub foo { 'My::Test::Class3::Base' } |
6cfa1e5e |
137 | |
67199842 |
138 | package My::Test::Class3; |
6cfa1e5e |
139 | use Mouse; |
140 | |
141 | extends 'My::Test::Class3::Base'; |
142 | |
67199842 |
143 | ::lives_ok { |
6cfa1e5e |
144 | with 'Role::Derived5', 'Role::Derived6'; |
67199842 |
145 | } '... roles composed okay (no conflicts)'; |
146 | } |
147 | |
148 | ok(Role::Base3->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); |
149 | ok(Role::Derived5->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); |
150 | ok(Role::Derived6->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); |
151 | ok(My::Test::Class3->meta->has_method('foo'), '... have the method foo as expected'); |
6fea087b |
152 | { |
153 | local $TODO = 'Not a Class::MOP::Method::Wrapped'; |
67199842 |
154 | isa_ok(My::Test::Class3->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); |
6fea087b |
155 | } |
67199842 |
156 | ok(My::Test::Class3::Base->meta->has_method('foo'), '... have the method foo as expected'); |
6fea087b |
157 | { |
158 | local $TODO = 'Not a Class::MOP::Method'; |
67199842 |
159 | isa_ok(My::Test::Class3::Base->meta->get_method('foo'), 'Class::MOP::Method'); |
6fea087b |
160 | } |
67199842 |
161 | is(My::Test::Class3::Base->foo, 'My::Test::Class3::Base', '... got the right value from method'); |
162 | is(My::Test::Class3->foo, 'Role::Base::foo(My::Test::Class3::Base)', '... got the right value from method'); |
163 | |
164 | =pod |
165 | |
6cfa1e5e |
166 | Check for repeated inheritance causing |
167 | a attr conflict (which is not really |
67199842 |
168 | a conflict) |
169 | |
170 | =cut |
171 | |
172 | { |
173 | package Role::Base4; |
174 | use Mouse::Role; |
6cfa1e5e |
175 | |
67199842 |
176 | has 'foo' => (is => 'ro', default => 'Role::Base::foo'); |
6cfa1e5e |
177 | |
67199842 |
178 | package Role::Derived7; |
6cfa1e5e |
179 | use Mouse::Role; |
180 | |
67199842 |
181 | with 'Role::Base4'; |
6cfa1e5e |
182 | |
67199842 |
183 | package Role::Derived8; |
6cfa1e5e |
184 | use Mouse::Role; |
67199842 |
185 | |
186 | with 'Role::Base4'; |
6cfa1e5e |
187 | |
67199842 |
188 | package My::Test::Class4; |
6cfa1e5e |
189 | use Mouse; |
190 | |
67199842 |
191 | ::lives_ok { |
6cfa1e5e |
192 | with 'Role::Derived7', 'Role::Derived8'; |
67199842 |
193 | } '... roles composed okay (no conflicts)'; |
194 | } |
195 | |
196 | ok(Role::Base4->meta->has_attribute('foo'), '... have the attribute foo as expected'); |
197 | ok(Role::Derived7->meta->has_attribute('foo'), '... have the attribute foo as expected'); |
198 | ok(Role::Derived8->meta->has_attribute('foo'), '... have the attribute foo as expected'); |
199 | ok(My::Test::Class4->meta->has_attribute('foo'), '... have the attribute foo as expected'); |
200 | |
201 | is(My::Test::Class4->new->foo, 'Role::Base::foo', '... got the right value from method'); |