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