1use strict;
2use warnings;
3use Test::More;
4use Test::Moose;
5use Moose::Util qw( does_role );
6
7{
8    package Foo::Meta::Attribute;
9    use Moose::Role;
10}
11
12{
13    package Foo::Meta::Attribute2;
14    use Moose::Role;
15}
16
17{
18    package Foo::Role;
19    use Moose::Role;
20
21    has foo => (is => 'ro');
22}
23
24{
25    package Foo;
26    use Moose;
27    Moose::Util::MetaRole::apply_metaroles(
28        for => __PACKAGE__,
29        class_metaroles => { attribute => ['Foo::Meta::Attribute'] },
30        role_metaroles  => { applied_attribute => ['Foo::Meta::Attribute2'] },
31    );
32    with 'Foo::Role';
33
34    has bar => (is => 'ro');
35}
36
37ok(Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute'), "attrs defined in the class get the class metarole applied");
38ok(!Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied");
39ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the metarole applied");
40ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the role metarole defined in the class applied");
41
42{
43    package Bar::Meta::Attribute;
44    use Moose::Role;
45}
46
47{
48    package Bar::Meta::Attribute2;
49    use Moose::Role;
50}
51
52{
53    package Bar::Role;
54    use Moose::Role;
55    Moose::Util::MetaRole::apply_metaroles(
56        for => __PACKAGE__,
57        class_metaroles => { attribute => ['Bar::Meta::Attribute'] },
58        role_metaroles  => { applied_attribute => ['Bar::Meta::Attribute2'] },
59    );
60
61    has foo => (is => 'ro');
62}
63
64{
65    package Bar;
66    use Moose;
67    with 'Bar::Role';
68
69    has bar => (is => 'ro');
70}
71
72ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute'), "attrs defined in the class don't get the class metarole from the role applied");
73ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied");
74ok(Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute2'), "attrs defined in the role get the role metarole applied");
75ok(!Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied");
76
77{
78    package Baz::Meta::Attribute;
79    use Moose::Role;
80}
81
82{
83    package Baz::Meta::Attribute2;
84    use Moose::Role;
85}
86
87{
88    package Baz::Role;
89    use Moose::Role;
90    Moose::Util::MetaRole::apply_metaroles(
91        for => __PACKAGE__,
92        class_metaroles => { attribute => ['Baz::Meta::Attribute'] },
93        role_metaroles  => { applied_attribute => ['Baz::Meta::Attribute2'] },
94    );
95
96    has foo => (is => 'ro');
97}
98
99{
100    package Baz;
101    use Moose;
102    Moose::Util::MetaRole::apply_metaroles(
103        for => __PACKAGE__,
104        class_metaroles => { attribute => ['Baz::Meta::Attribute'] },
105        role_metaroles  => { applied_attribute => ['Baz::Meta::Attribute2'] },
106    );
107    with 'Baz::Role';
108
109    has bar => (is => 'ro');
110}
111
112ok(Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute'), "attrs defined in the class get the class metarole applied");
113ok(!Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied");
114ok(Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute2'), "attrs defined in the role get the role metarole applied");
115ok(!Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied");
116
117{
118    package Accessor::Modifying::Role;
119    use Moose::Role;
120
121    around _process_options => sub {
122        my $orig = shift;
123        my $self = shift;
124        my ($name, $params) = @_;
125        $self->$orig(@_);
126        $params->{reader} .= '_foo';
127    };
128}
129
130{
131    package Plain::Role;
132    use Moose::Role;
133
134    has foo => (
135        is  => 'ro',
136        isa => 'Str',
137    );
138}
139
140{
141    package Class::With::Trait;
142    use Moose;
143    Moose::Util::MetaRole::apply_metaroles(
144        for => __PACKAGE__,
145        class_metaroles => {
146            attribute => ['Accessor::Modifying::Role'],
147        },
148    );
149    with 'Plain::Role';
150
151    has bar => (
152        is  => 'ro',
153        isa => 'Str',
154    );
155}
156
157{
158    can_ok('Class::With::Trait', 'foo');
159    can_ok('Class::With::Trait', 'bar_foo');
160}
161
162{
163    package Role::With::Trait;
164    use Moose::Role;
165    Moose::Util::MetaRole::apply_metaroles(
166        for => __PACKAGE__,
167        role_metaroles => {
168            applied_attribute => ['Accessor::Modifying::Role'],
169        },
170    );
171    with 'Plain::Role';
172
173    has foo => (
174        is  => 'ro',
175        isa => 'Str',
176    );
177
178    sub foo_test {
179        my $self = shift;
180        return $self->can('foo_foo');
181    }
182}
183
184{
185    package Class::With::Role::With::Trait;
186    use Moose;
187    with 'Role::With::Trait';
188
189    has bar => (
190        is  => 'ro',
191        isa => 'Str',
192    );
193
194    sub bar_test {
195        my $self = shift;
196        return $self->can('bar');
197    }
198}
199
200{
201    can_ok('Class::With::Role::With::Trait', 'foo_foo');
202    can_ok('Class::With::Role::With::Trait', 'bar');
203}
204
205{
206    package Quux::Meta::Role::Attribute;
207    use Moose::Role;
208}
209
210{
211    package Quux::Role1;
212    use Moose::Role;
213
214    has foo => (traits => ['Quux::Meta::Role::Attribute'], is => 'ro');
215    has baz => (is => 'ro');
216}
217
218{
219    package Quux::Role2;
220    use Moose::Role;
221    Moose::Util::MetaRole::apply_metaroles(
222        for            => __PACKAGE__,
223        role_metaroles => {
224            applied_attribute => ['Quux::Meta::Role::Attribute']
225        },
226    );
227
228    has bar => (is => 'ro');
229}
230
231{
232    package Quux;
233    use Moose;
234    with 'Quux::Role1', 'Quux::Role2';
235}
236
237{
238    my $foo = Quux->meta->get_attribute('foo');
239    does_ok($foo, 'Quux::Meta::Role::Attribute',
240            "individual attribute trait applied correctly");
241
242    my $baz = Quux->meta->get_attribute('baz');
243    ok(! does_role($baz, 'Quux::Meta::Role::Attribute'),
244       "applied_attribute traits do not end up applying to attributes from other roles during composition");
245
246    my $bar = Quux->meta->get_attribute('bar');
247    does_ok($bar, 'Quux::Meta::Role::Attribute',
248            "attribute metarole applied correctly");
249}
250
251{
252    package HasMeta;
253    use Moose::Role;
254    Moose::Util::MetaRole::apply_metaroles(
255        for            => __PACKAGE__,
256        role_metaroles => {
257            applied_attribute => ['Quux::Meta::Role::Attribute']
258        },
259    );
260
261    has foo => (is => 'ro');
262}
263
264{
265    package NoMeta;
266    use Moose::Role;
267
268    with 'HasMeta';
269
270    has bar => (is => 'ro');
271}
272
273{
274    package ConsumesBoth;
275    use Moose;
276    with 'HasMeta', 'NoMeta';
277}
278
279{
280    my $foo = ConsumesBoth->meta->get_attribute('foo');
281    does_ok($foo, 'Quux::Meta::Role::Attribute',
282            'applied_attribute traits are preserved when one role consumes another');
283
284    my $bar = ConsumesBoth->meta->get_attribute('bar');
285    ok(! does_role($bar, 'Quux::Meta::Role::Attribute'),
286       "applied_attribute traits do not spill over from consumed role");
287}
288
289
290
291done_testing;
292