Fix duplicate test number (why do we have these numbers anyway?)
[gitmo/Moose.git] / t / 030_roles / 046_role_attr_application.t
CommitLineData
13eb2af6 1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Test::More;
0cef9fe9 5use Test::Moose;
13eb2af6 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
0cef9fe9 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}
216
217{
218 package Quux::Role2;
219 use Moose::Role;
220 Moose::Util::MetaRole::apply_metaroles(
221 for => __PACKAGE__,
222 role_metaroles => {
223 applied_attribute => ['Quux::Meta::Role::Attribute']
224 },
225 );
226
227 has bar => (is => 'ro');
228}
229
230{
231 package Quux;
232 use Moose;
233 with 'Quux::Role1', 'Quux::Role2';
234}
235
236{
237 my $foo = Quux->meta->get_attribute('foo');
238 does_ok($foo, 'Quux::Meta::Role::Attribute',
239 "individual attribute trait applied correctly");
240}
241
242{
243 local $TODO = "applied_attribute metaroles are lost in role composition";
244 my $bar = Quux->meta->get_attribute('bar');
245 does_ok($bar, 'Quux::Meta::Role::Attribute',
246 "attribute metarole applied correctly");
247}
248
13eb2af6 249done_testing;