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