add comments explaining rationale for handling of requires in create_class_with_roles
[gitmo/Role-Tiny.git] / t / role-basic-composition.t
CommitLineData
60dfe768 1#!/usr/bin/env perl
2
3use lib 'lib', 't/role-basic/lib';
4use MyTests;
2c580674 5require 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
28eval <<'END_PACKAGE';
29package My::Class1;
2c580674 30use Role::Tiny 'with';
60dfe768 31with qw(
32 My::Does::Basic1
33 My::Does::Basic2
34);
35sub turbo_charger {}
36END_PACKAGE
37ok !$@, '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
51eval <<'END_PACKAGE';
52package My::Class2;
2c580674 53use Role::Tiny 'with';
60dfe768 54with qw(
55 My::Does::Basic3
56);
57sub new { bless {} => shift }
58sub turbo_charger {}
59END_PACKAGE
60ok !$@, 'We should be able to use roles which consume roles'
61 or die $@;
62can_ok 'My::Class2', 'method2';
63is My::Class2->method2, 'My::Does::Basic2 method2',
64 '... and it should be the correct method';
65can_ok 'My::Class2', 'method3';
66is My::Class2->method3, 'My::Does::Basic3 method3',
67 '... and it should be the correct method';
68
69ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes';
70ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'),
71 '... and should do roles which its roles consumes';
72ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'),
73 '... but not roles which it never consumed';
74
75my $object = My::Class2->new;
76ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes';
77ok $object->Role::Tiny::does_role('My::Does::Basic2'),
78 '... and should do roles which its roles consumes';
79ok !$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
f4afc2d1 149SKIP: {
150 skip "Class::Method::Modifiers not installed or too old", 1
151 unless eval "use Class::Method::Modifiers 1.05; 1";
c1f47a53 152 {
153 package Modifier::Role1;
f4afc2d1 154 use Role::Tiny;
c1f47a53 155 sub foo {
156 }
157 before 'bar', sub {};
158 }
159
160 {
161 package Modifier::Role2;
f4afc2d1 162 use Role::Tiny;
c1f47a53 163 sub bar {
164 }
165 before 'foo', sub {};
166 }
167 my $success = eval q{
168 package Class;
f4afc2d1 169 use Role::Tiny::With;
c1f47a53 170 with 'Modifier::Role1', 'Modifier::Role2';
171 1;
172 };
173 is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@";
b0efdecc 174}
175
1f8e33fe 176{
177 {
178 package Base::Role;
179 use Role::Tiny;
180 requires qw/method1 method2/;
181 }
182
183 {
184 package Sub::Role1;
185 use Role::Tiny;
186 with 'Base::Role';
187 sub method1 {}
188 }
189
190 {
191 package Sub::Role2;
192 use Role::Tiny;
193 with 'Base::Role';
194 sub method2 {}
195 }
196
197 my $success = eval q{
198 package Diamant::Class;
199 use Role::Tiny::With;
200 with qw/Sub::Role1 Sub::Role2/;
201 1;
202 };
203 is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@";
204}
205
60dfe768 206done_testing;