Commit | Line | Data |
60dfe768 |
1 | use lib 'lib', 't/role-basic/lib'; |
2 | use MyTests; |
2c580674 |
3 | require Role::Tiny; |
60dfe768 |
4 | |
5 | { |
6 | |
7 | package My::Does::Basic1; |
2c580674 |
8 | use Role::Tiny; |
60dfe768 |
9 | requires 'turbo_charger'; |
10 | |
11 | sub method { |
12 | return __PACKAGE__ . " method"; |
13 | } |
14 | } |
15 | { |
16 | |
17 | package My::Does::Basic2; |
2c580674 |
18 | use Role::Tiny; |
60dfe768 |
19 | requires 'turbo_charger'; |
20 | |
21 | sub method2 { |
22 | return __PACKAGE__ . " method2"; |
23 | } |
24 | } |
25 | |
26 | eval <<'END_PACKAGE'; |
27 | package My::Class1; |
2c580674 |
28 | use Role::Tiny 'with'; |
60dfe768 |
29 | with qw( |
30 | My::Does::Basic1 |
31 | My::Does::Basic2 |
32 | ); |
33 | sub turbo_charger {} |
34 | END_PACKAGE |
35 | ok !$@, 'We should be able to use two roles with the same requirements' |
36 | or die $@; |
37 | |
38 | { |
39 | |
40 | package My::Does::Basic3; |
2c580674 |
41 | use Role::Tiny; |
60dfe768 |
42 | with 'My::Does::Basic2'; |
43 | |
44 | sub method3 { |
45 | return __PACKAGE__ . " method3"; |
46 | } |
47 | } |
48 | |
49 | eval <<'END_PACKAGE'; |
50 | package My::Class2; |
2c580674 |
51 | use Role::Tiny 'with'; |
60dfe768 |
52 | with qw( |
53 | My::Does::Basic3 |
54 | ); |
55 | sub new { bless {} => shift } |
56 | sub turbo_charger {} |
57 | END_PACKAGE |
58 | ok !$@, 'We should be able to use roles which consume roles' |
59 | or die $@; |
60 | can_ok 'My::Class2', 'method2'; |
61 | is My::Class2->method2, 'My::Does::Basic2 method2', |
62 | '... and it should be the correct method'; |
63 | can_ok 'My::Class2', 'method3'; |
64 | is My::Class2->method3, 'My::Does::Basic3 method3', |
65 | '... and it should be the correct method'; |
66 | |
67 | ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes'; |
68 | ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'), |
69 | '... and should do roles which its roles consumes'; |
70 | ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'), |
71 | '... but not roles which it never consumed'; |
72 | |
73 | my $object = My::Class2->new; |
74 | ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes'; |
75 | ok $object->Role::Tiny::does_role('My::Does::Basic2'), |
76 | '... and should do roles which its roles consumes'; |
77 | ok !$object->Role::Tiny::does_role('My::Does::Basic1'), |
78 | '... but not roles which it never consumed'; |
79 | |
80 | { |
81 | { |
82 | package Role::Which::Imports; |
2c580674 |
83 | use Role::Tiny allow => 'TestMethods'; |
60dfe768 |
84 | use TestMethods qw(this that); |
85 | } |
86 | { |
87 | package Class::With::ImportingRole; |
2c580674 |
88 | use Role::Tiny 'with'; |
60dfe768 |
89 | with 'Role::Which::Imports'; |
90 | sub new { bless {} => shift } |
91 | } |
92 | my $o = Class::With::ImportingRole->new; |
93 | |
94 | foreach my $method (qw/this that/) { |
95 | can_ok $o, $method; |
96 | ok $o->$method($method), '... and calling "allow"ed methods should succeed'; |
97 | is $o->$method, $method, '... and it should function correctly'; |
98 | } |
99 | } |
100 | |
101 | { |
102 | { |
103 | package Role::WithImportsOnceRemoved; |
2c580674 |
104 | use Role::Tiny; |
60dfe768 |
105 | with 'Role::Which::Imports'; |
106 | } |
107 | { |
108 | package Class::With::ImportingRole2; |
2c580674 |
109 | use Role::Tiny 'with'; |
60dfe768 |
110 | $ENV{DEBUG} = 1; |
111 | with 'Role::WithImportsOnceRemoved'; |
112 | sub new { bless {} => shift } |
113 | } |
114 | ok my $o = Class::With::ImportingRole2->new, |
115 | 'We should be able to use roles which compose roles which import'; |
116 | |
117 | foreach my $method (qw/this that/) { |
118 | can_ok $o, $method; |
119 | ok $o->$method($method), '... and calling "allow"ed methods should succeed'; |
120 | is $o->$method, $method, '... and it should function correctly'; |
121 | } |
122 | } |
123 | |
b0efdecc |
124 | { |
125 | { |
c1f47a53 |
126 | package Method::Role1; |
b0efdecc |
127 | use Role::Tiny; |
128 | sub method1 { } |
129 | requires 'method2'; |
130 | } |
131 | |
132 | { |
c1f47a53 |
133 | package Method::Role2; |
b0efdecc |
134 | use Role::Tiny; |
135 | sub method2 { } |
136 | requires 'method1'; |
137 | } |
c1f47a53 |
138 | my $success = eval q{ |
b0efdecc |
139 | package Class; |
140 | use Role::Tiny::With; |
c1f47a53 |
141 | with 'Method::Role1', 'Method::Role2'; |
b0efdecc |
142 | 1; |
c1f47a53 |
143 | }; |
144 | is $success, 1, 'composed mutually dependent methods successfully' or diag "Error: $@"; |
145 | } |
146 | |
f4afc2d1 |
147 | SKIP: { |
148 | skip "Class::Method::Modifiers not installed or too old", 1 |
149 | unless eval "use Class::Method::Modifiers 1.05; 1"; |
c1f47a53 |
150 | { |
151 | package Modifier::Role1; |
f4afc2d1 |
152 | use Role::Tiny; |
c1f47a53 |
153 | sub foo { |
154 | } |
155 | before 'bar', sub {}; |
156 | } |
157 | |
158 | { |
159 | package Modifier::Role2; |
f4afc2d1 |
160 | use Role::Tiny; |
c1f47a53 |
161 | sub bar { |
162 | } |
163 | before 'foo', sub {}; |
164 | } |
165 | my $success = eval q{ |
166 | package Class; |
f4afc2d1 |
167 | use Role::Tiny::With; |
c1f47a53 |
168 | with 'Modifier::Role1', 'Modifier::Role2'; |
169 | 1; |
170 | }; |
171 | is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@"; |
b0efdecc |
172 | } |
173 | |
1f8e33fe |
174 | { |
175 | { |
176 | package Base::Role; |
177 | use Role::Tiny; |
178 | requires qw/method1 method2/; |
179 | } |
180 | |
181 | { |
182 | package Sub::Role1; |
183 | use Role::Tiny; |
184 | with 'Base::Role'; |
185 | sub method1 {} |
186 | } |
187 | |
188 | { |
189 | package Sub::Role2; |
190 | use Role::Tiny; |
191 | with 'Base::Role'; |
192 | sub method2 {} |
193 | } |
194 | |
195 | my $success = eval q{ |
196 | package Diamant::Class; |
197 | use Role::Tiny::With; |
198 | with qw/Sub::Role1 Sub::Role2/; |
199 | 1; |
200 | }; |
201 | is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@"; |
202 | } |
203 | |
60dfe768 |
204 | done_testing; |