Ignore all .git.*
[gitmo/Class-MOP.git] / t / 005_attributes.t
CommitLineData
2eb717d5 1use strict;
2use warnings;
3
ffba6596 4use Test::More tests => 73;
2eb717d5 5use Test::Exception;
6
efd3d14c 7use Class::MOP;
2eb717d5 8
9my $FOO_ATTR = Class::MOP::Attribute->new('$foo');
10my $BAR_ATTR = Class::MOP::Attribute->new('$bar' => (
11 accessor => 'bar'
12));
13my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
14 reader => 'get_baz',
1d68af04 15 writer => 'set_baz',
2eb717d5 16));
17
22286063 18my $BAR_ATTR_2 = Class::MOP::Attribute->new('$bar');
19
1d68af04 20my $FOO_ATTR_2 = Class::MOP::Attribute->new('$foo' => (
21 accessor => 'foo',
22 builder => 'build_foo'
23));
24
aef6c672 25is($FOO_ATTR->name, '$foo', '... got the attributes name correctly');
26is($BAR_ATTR->name, '$bar', '... got the attributes name correctly');
27is($BAZ_ATTR->name, '$baz', '... got the attributes name correctly');
28
2eb717d5 29{
30 package Foo;
aa448b16 31 use metaclass;
2eb717d5 32
727919c5 33 my $meta = Foo->meta;
2eb717d5 34 ::lives_ok {
35 $meta->add_attribute($FOO_ATTR);
36 } '... we added an attribute to Foo successfully';
37 ::ok($meta->has_attribute('$foo'), '... Foo has $foo attribute');
38 ::is($meta->get_attribute('$foo'), $FOO_ATTR, '... got the right attribute back for Foo');
1d68af04 39
2eb717d5 40 ::ok(!$meta->has_method('foo'), '... no accessor created');
1d68af04 41
22286063 42 ::lives_ok {
43 $meta->add_attribute($BAR_ATTR_2);
44 } '... we added an attribute to Foo successfully';
45 ::ok($meta->has_attribute('$bar'), '... Foo has $bar attribute');
1d68af04 46 ::is($meta->get_attribute('$bar'), $BAR_ATTR_2, '... got the right attribute back for Foo');
22286063 47
48 ::ok(!$meta->has_method('bar'), '... no accessor created');
2eb717d5 49}
50{
51 package Bar;
52 our @ISA = ('Foo');
1d68af04 53
727919c5 54 my $meta = Bar->meta;
2eb717d5 55 ::lives_ok {
56 $meta->add_attribute($BAR_ATTR);
57 } '... we added an attribute to Bar successfully';
58 ::ok($meta->has_attribute('$bar'), '... Bar has $bar attribute');
59 ::is($meta->get_attribute('$bar'), $BAR_ATTR, '... got the right attribute back for Bar');
60
b25109b1 61 my $attr = $meta->get_attribute('$bar');
62 ::is($attr->get_read_method, 'bar', '... got the right read method for Bar');
63 ::is($attr->get_write_method, 'bar', '... got the right write method for Bar');
64
2eb717d5 65 ::ok($meta->has_method('bar'), '... an accessor has been created');
1d68af04 66 ::isa_ok($meta->get_method('bar'), 'Class::MOP::Method::Accessor');
2eb717d5 67}
68{
69 package Baz;
70 our @ISA = ('Bar');
1d68af04 71
727919c5 72 my $meta = Baz->meta;
2eb717d5 73 ::lives_ok {
74 $meta->add_attribute($BAZ_ATTR);
75 } '... we added an attribute to Baz successfully';
1d68af04 76 ::ok($meta->has_attribute('$baz'), '... Baz has $baz attribute');
2eb717d5 77 ::is($meta->get_attribute('$baz'), $BAZ_ATTR, '... got the right attribute back for Baz');
78
b25109b1 79 my $attr = $meta->get_attribute('$baz');
80 ::is($attr->get_read_method, 'get_baz', '... got the right read method for Baz');
81 ::is($attr->get_write_method, 'set_baz', '... got the right write method for Baz');
82
2eb717d5 83 ::ok($meta->has_method('get_baz'), '... a reader has been created');
84 ::ok($meta->has_method('set_baz'), '... a writer has been created');
85
ba38bf08 86 ::isa_ok($meta->get_method('get_baz'), 'Class::MOP::Method::Accessor');
87 ::isa_ok($meta->get_method('set_baz'), 'Class::MOP::Method::Accessor');
2eb717d5 88}
89
90{
ffba6596 91 package Foo2;
92 use metaclass;
93
94 my $meta = Foo2->meta;
95 $meta->add_attribute(
96 Class::MOP::Attribute->new( '$foo2' => ( reader => 'foo2' ) ) );
97
98 ::ok( $meta->has_method('foo2'), '... a reader has been created' );
99
100 my $attr = $meta->get_attribute('$foo2');
101 ::is( $attr->get_read_method, 'foo2',
102 '... got the right read method for Foo2' );
103 ::is( $attr->get_write_method, undef,
104 '... got undef for the writer with a read-only attribute in Foo2' );
105}
106
107{
2eb717d5 108 my $meta = Baz->meta;
109 isa_ok($meta, 'Class::MOP::Class');
1d68af04 110
058c1cf5 111 is($meta->find_attribute_by_name('$bar'), $BAR_ATTR, '... got the right attribute for "bar"');
1d68af04 112 is($meta->find_attribute_by_name('$baz'), $BAZ_ATTR, '... got the right attribute for "baz"');
113 is($meta->find_attribute_by_name('$foo'), $FOO_ATTR, '... got the right attribute for "foo"');
114
2eb717d5 115 is_deeply(
c9e77dbb 116 [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
1d68af04 117 [
c9e77dbb 118 $BAR_ATTR,
119 $BAZ_ATTR,
1d68af04 120 $FOO_ATTR,
2eb717d5 121 ],
122 '... got the right list of applicable attributes for Baz');
1d68af04 123
c9e77dbb 124 is_deeply(
125 [ map { $_->associated_class } sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
126 [ Bar->meta, Baz->meta, Foo->meta ],
1d68af04 127 '... got the right list of associated classes from the applicable attributes for Baz');
128
cbd9f942 129 my $attr;
130 lives_ok {
131 $attr = $meta->remove_attribute('$baz');
132 } '... removed the $baz attribute successfully';
1d68af04 133 is($attr, $BAZ_ATTR, '... got the right attribute back for Baz');
134
135 ok(!$meta->has_attribute('$baz'), '... Baz no longer has $baz attribute');
136 is($meta->get_attribute('$baz'), undef, '... Baz no longer has $baz attribute');
cbd9f942 137
138 ok(!$meta->has_method('get_baz'), '... a reader has been removed');
139 ok(!$meta->has_method('set_baz'), '... a writer has been removed');
140
141 is_deeply(
c9e77dbb 142 [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
1d68af04 143 [
c9e77dbb 144 $BAR_ATTR,
1d68af04 145 $FOO_ATTR,
cbd9f942 146 ],
147 '... got the right list of applicable attributes for Baz');
148
c9e77dbb 149 is_deeply(
150 [ map { $_->associated_class } sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
151 [ Bar->meta, Foo->meta ],
152 '... got the right list of associated classes from the applicable attributes for Baz');
153
cbd9f942 154 {
155 my $attr;
156 lives_ok {
157 $attr = Bar->meta->remove_attribute('$bar');
158 } '... removed the $bar attribute successfully';
1d68af04 159 is($attr, $BAR_ATTR, '... got the right attribute back for Bar');
2eb717d5 160
1d68af04 161 ok(!Bar->meta->has_attribute('$bar'), '... Bar no longer has $bar attribute');
2eb717d5 162
cbd9f942 163 ok(!Bar->meta->has_method('bar'), '... a accessor has been removed');
164 }
165
166 is_deeply(
c9e77dbb 167 [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
1d68af04 168 [
22286063 169 $BAR_ATTR_2,
1d68af04 170 $FOO_ATTR,
cbd9f942 171 ],
172 '... got the right list of applicable attributes for Baz');
173
c9e77dbb 174 is_deeply(
175 [ map { $_->associated_class } sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
22286063 176 [ Foo->meta, Foo->meta ],
c9e77dbb 177 '... got the right list of associated classes from the applicable attributes for Baz');
178
22286063 179 # remove attribute which is not there
180 my $val;
181 lives_ok {
182 $val = $meta->remove_attribute('$blammo');
183 } '... attempted to remove the non-existent $blammo attribute';
184 is($val, undef, '... got the right value back (undef)');
185
cbd9f942 186}
1d68af04 187
188{
189 package Buzz;
190 use metaclass;
191 use Scalar::Util qw/blessed/;
192
193 my $meta = Buzz->meta;
194 ::lives_ok {
195 $meta->add_attribute($FOO_ATTR_2);
196 } '... we added an attribute to Buzz successfully';
197
198 ::lives_ok {
8768ecf3 199 $meta->add_attribute(
200 Class::MOP::Attribute->new(
201 '$bar' => (
202 accessor => 'bar',
203 predicate => 'has_bar',
204 clearer => 'clear_bar',
205 )
206 )
207 );
208 } '... we added an attribute to Buzz successfully';
209
210 ::lives_ok {
211 $meta->add_attribute(
212 Class::MOP::Attribute->new(
213 '$bah' => (
214 accessor => 'bah',
215 predicate => 'has_bah',
216 clearer => 'clear_bah',
217 default => 'BAH',
218 )
219 )
220 );
221 } '... we added an attribute to Buzz successfully';
222
223 ::lives_ok {
1d68af04 224 $meta->add_method(build_foo => sub{ blessed shift; });
225 } '... we added a method to Buzz successfully';
226}
227
228{
229 my $buzz;
230 ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
8768ecf3 231 ::is($buzz->foo, 'Buzz', '...foo builder works as expected');
232 ::ok(!$buzz->has_bar, '...bar is not set');
233 ::is($buzz->bar, undef, '...bar returns undef');
234 ::ok(!$buzz->has_bar, '...bar was not autovivified');
235
236 $buzz->bar(undef);
237 ::ok($buzz->has_bar, '...bar is set');
238 ::is($buzz->bar, undef, '...bar is undef');
239 $buzz->clear_bar;
240 ::ok(!$buzz->has_bar, '...bar is no longerset');
241
242 my $buzz2;
243 ::lives_ok { $buzz2 = Buzz->meta->new_object('$bar' => undef) } '...Buzz instantiated successfully';
244 ::ok($buzz2->has_bar, '...bar is set');
245 ::is($buzz2->bar, undef, '...bar is undef');
246
247}
248
249{
250 my $buzz;
251 ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
252 ::ok($buzz->has_bah, '...bah is set');
253 ::is($buzz->bah, 'BAH', '...bah returns "BAH" ');
254
255 my $buzz2;
256 ::lives_ok { $buzz2 = Buzz->meta->new_object('$bah' => undef) } '...Buzz instantiated successfully';
257 ::ok($buzz2->has_bah, '...bah is set');
258 ::is($buzz2->bah, undef, '...bah is undef');
259
1d68af04 260}