Perltidy this code a bit.
[gitmo/Moose.git] / t / 030_roles / 011_overriding.t
CommitLineData
4c15a12d 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
28412c0b 6use Test::More tests => 40;
4c15a12d 7use Test::Exception;
8
9BEGIN {
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 45can_ok( Class::A->new, qw(foo bar xxy zot) );
4c15a12d 46
c4538447 47is( Class::A->new->foo, "Role::C::foo", "... got the right foo method" );
48is( Class::A->new->zot, "Class::A::zot", "... got the right zot method" );
49is( Class::A->new->bar, "Role::A::bar", "... got the right bar method" );
50is( 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 81ok(Role::A::Conflict->meta->requires_method('bar'), '... Role::A::Conflict created the bar requirement');
4c15a12d 82
c4538447 83can_ok( Class::A::Resolved->new, qw(bar) );
4c15a12d 84
c4538447 85is( 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 123can_ok( Class::B->new, qw(foo bar xxy zot) );
4c15a12d 124
c4538447 125is( Class::B->new->foo, "Role::F::foo", "... got the &foo method okay" );
126is( Class::B->new->zot, "Class::B::zot", "... got the &zot method okay" );
127is( Class::B->new->bar, "Role::D::bar", "... got the &bar method okay" );
128is( Class::B->new->xxy, "Role::E::xxy", "... got the &xxy method okay" );
129
130ok(!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 152ok(!Role::D::And::E::Conflict->meta->requires_method('foo'), '... Role::D::And::E::Conflict fufilled the &foo requirement');
153ok(Role::D::And::E::Conflict->meta->requires_method('xxy'), '... Role::D::And::E::Conflict adds the &xxy requirement');
154ok(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
200can_ok( Class::E->new, qw(foo bar xxy zot) );
4c15a12d 201
c4538447 202is( Class::E->new->foo, "Class::E::foo", "... got the right &foo method" );
203is( Class::E->new->zot, "Class::E::zot", "... got the right &zot method" );
204is( Class::E->new->bar, "Role::H::bar", "... got the right &bar method" );
205is( Class::E->new->xxy, "Role::J::xxy", "... got the right &xxy method" );
4c15a12d 206
c4538447 207ok(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