1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
#!/usr/bin/perl
use strict;
use warnings;
use lib 'lib', 't/lib';
use MyTests tests => 46;
{
package My::Role;
use Role::Basic;
sub foo { 'Foo::foo' }
sub bar { 'Foo::bar' }
sub baz { 'Foo::baz' }
requires 'role_bar';
package My::Class;
use Role::Basic 'with';
::is( ::exception {
with 'My::Role' => { -alias => { bar => 'role_bar' } };
}, undef, '... this succeeds' );
package My::Class::Failure;
use Role::Basic 'with';
::like( ::exception {
with 'My::Role' => { -alias => { bar => 'role_bar' } };
}, qr/Cannot alias 'bar' to 'role_bar' as a method of that name already exists in My::Class::Failure/, '... this succeeds' );
sub role_bar { 'FAIL' }
}
ok(My::Class->can($_), "we have a $_ method") for qw(foo baz bar role_bar);
{
package My::OtherRole;
use Role::Basic;
::is( ::exception {
with 'My::Role' => { -alias => { bar => 'role_bar' } };
}, undef, '... this succeeds' );
sub bar { 'My::OtherRole::bar' }
package My::OtherRole::Failure;
use Role::Basic;
::like( ::exception {
with 'My::Role' => { -alias => { bar => 'role_bar' } };
}, qr/Cannot alias 'bar' to 'role_bar' as a method of that name already exists in My::OtherRole::Failure/, '... cannot alias to a name that exists' );
sub role_bar { 'FAIL' }
}
ok(My::OtherRole->can($_), "we have a $_ method") for qw(foo baz role_bar);
TODO: {
local $TODO = 'Still unsure if this behavior us needed. Failure provides no guarantees';
ok(Role::Basic->requires_method("My::OtherRole", 'bar'), '... and the &bar method is required');
ok(!Role::Basic->requires_method("My::OtherRole", 'role_bar'), '... and the &role_bar method is not required');
}
{
package My::AliasingRole;
use Role::Basic;
::is( ::exception {
with 'My::Role' => { -alias => { bar => 'role_bar' } };
}, undef, '... this succeeds' );
}
ok(My::AliasingRole->can($_), "we have a $_ method") for qw(foo baz role_bar);
ok(!Role::Basic->requires_method("My::AliasingRole", 'bar'), '... and the &bar method is not required');
{
package Foo::Role;
use Role::Basic;
sub foo { 'Foo::Role::foo' }
package Bar::Role;
use Role::Basic;
sub foo { 'Bar::Role::foo' }
package Baz::Role;
use Role::Basic;
sub foo { 'Baz::Role::foo' }
package My::Foo::Class;
use Role::Basic 'with';
sub new { bless {} => shift }
::is( ::exception {
with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Bar::Role' => { -alias => { 'foo' => 'bar_foo' }, -excludes => 'foo' },
'Baz::Role';
}, undef, '... composed our roles correctly' );
package My::Foo::Class::Broken;
use Role::Basic 'with';
# XXX due to how we're structured, we hit the 'alias' error before the
# "method conflict" error which Moose gets
::like( ::exception {
with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Bar::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Baz::Role';
}, qr/Cannot alias 'foo' to 'foo_foo' as a method of that name already exists in My::Foo::Class::Broken/, '... composed our roles correctly' );
}
{
my $foo = My::Foo::Class->new;
isa_ok($foo, 'My::Foo::Class');
can_ok($foo, $_) for qw/foo foo_foo bar_foo/;
is($foo->foo, 'Baz::Role::foo', '... got the right method');
is($foo->foo_foo, 'Foo::Role::foo', '... got the right method');
is($foo->bar_foo, 'Bar::Role::foo', '... got the right method');
}
{
package My::Foo::Role;
use Role::Basic;
::is( ::exception {
with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Bar::Role' => { -alias => { 'foo' => 'bar_foo' }, -excludes => 'foo' },
'Baz::Role';
}, undef, '... composed our roles correctly' );
}
ok(My::Foo::Role->can($_), "we have a $_ method") for qw/foo foo_foo bar_foo/;;
# XXX [!Moose]
TODO: {
local $TODO = 'fix requires';
ok(Role::Basic->requires_method("My::Foo::Role", 'foo'), '... and the &foo method is required');
}
{
package My::Foo::Role::Other;
use Role::Basic;
# XXX again, we propogate errors immediately rather than generating
# requirements
::isnt( ::exception {
with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Bar::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Baz::Role';
}, undef, '... composed our roles correctly' );
}
TODO: {
local $TODO = 'We probably should make no guarantees on failure';
ok(!My::Foo::Role::Other->can('foo_foo'), "we dont have a foo_foo method");
ok(Role::Basic->requires_method("My::Foo::Role::Other", 'foo_foo'), '... and the &foo method is required');
}
{
package My::Foo::AliasOnly;
use Role::Basic 'with';
::is( ::exception {
with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' } },
}, undef, '... composed our roles correctly' );
}
ok(My::Foo::AliasOnly->can('foo'), 'we have a foo method');
ok(My::Foo::AliasOnly->can('foo_foo'), '.. and the aliased foo_foo method');
{
package Role::Foo;
use Role::Basic;
sub x1 {}
sub y1 {}
}
{
package Role::Bar;
use Role::Basic;
::is( ::exception {
with 'Role::Foo' => {
-alias => { x1 => 'foo_x1' },
-excludes => ['y1'],
};
}, undef, 'Compose Role::Foo into Role::Bar with alias and exclude' );
sub x1 {}
sub y1 {}
}
{
ok( Role::Bar->can($_), "can $_ method" )
for qw( x1 y1 foo_x1 );
}
{
package Role::Baz;
use Role::Basic;
::is( ::exception {
with 'Role::Foo' => {
-alias => { x1 => 'foo_x1' },
-excludes => ['y1'],
};
}, undef, 'Compose Role::Foo into Role::Baz with alias and exclude' );
}
{
ok( Role::Baz->can($_), "has $_ method" )
for qw( x1 foo_x1 );
ok( ! Role::Baz->can('y1'), 'Role::Baz has no y1 method' );
}
|
