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