Ignore all .git.*
[gitmo/Class-MOP.git] / t / 005_attributes.t
1 use strict;
2 use warnings;
3
4 use Test::More tests => 73;
5 use Test::Exception;
6
7 use Class::MOP;
8
9 my $FOO_ATTR = Class::MOP::Attribute->new('$foo');
10 my $BAR_ATTR = Class::MOP::Attribute->new('$bar' => (
11     accessor => 'bar'
12 ));
13 my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
14     reader => 'get_baz',
15     writer => 'set_baz',
16 ));
17
18 my $BAR_ATTR_2 = Class::MOP::Attribute->new('$bar');
19
20 my $FOO_ATTR_2 = Class::MOP::Attribute->new('$foo' => (
21     accessor => 'foo',
22     builder => 'build_foo'
23 ));
24
25 is($FOO_ATTR->name, '$foo', '... got the attributes name correctly');
26 is($BAR_ATTR->name, '$bar', '... got the attributes name correctly');
27 is($BAZ_ATTR->name, '$baz', '... got the attributes name correctly');
28
29 {
30     package Foo;
31     use metaclass;
32
33     my $meta = Foo->meta;
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');
39
40     ::ok(!$meta->has_method('foo'), '... no accessor created');
41
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');
46     ::is($meta->get_attribute('$bar'), $BAR_ATTR_2, '... got the right attribute back for Foo');
47
48     ::ok(!$meta->has_method('bar'), '... no accessor created');
49 }
50 {
51     package Bar;
52     our @ISA = ('Foo');
53
54     my $meta = Bar->meta;
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
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
65     ::ok($meta->has_method('bar'), '... an accessor has been created');
66     ::isa_ok($meta->get_method('bar'), 'Class::MOP::Method::Accessor');
67 }
68 {
69     package Baz;
70     our @ISA = ('Bar');
71
72     my $meta = Baz->meta;
73     ::lives_ok {
74         $meta->add_attribute($BAZ_ATTR);
75     } '... we added an attribute to Baz successfully';
76     ::ok($meta->has_attribute('$baz'), '... Baz has $baz attribute');
77     ::is($meta->get_attribute('$baz'), $BAZ_ATTR, '... got the right attribute back for Baz');
78
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
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
86     ::isa_ok($meta->get_method('get_baz'), 'Class::MOP::Method::Accessor');
87     ::isa_ok($meta->get_method('set_baz'), 'Class::MOP::Method::Accessor');
88 }
89
90 {
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 {
108     my $meta = Baz->meta;
109     isa_ok($meta, 'Class::MOP::Class');
110
111     is($meta->find_attribute_by_name('$bar'), $BAR_ATTR, '... got the right attribute for "bar"');
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
115     is_deeply(
116         [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
117         [
118             $BAR_ATTR,
119             $BAZ_ATTR,
120             $FOO_ATTR,
121         ],
122         '... got the right list of applicable attributes for Baz');
123
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 ],
127         '... got the right list of associated classes from the applicable attributes for Baz');
128
129     my $attr;
130     lives_ok {
131         $attr = $meta->remove_attribute('$baz');
132     } '... removed the $baz attribute successfully';
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');
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(
142         [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
143         [
144             $BAR_ATTR,
145             $FOO_ATTR,
146         ],
147         '... got the right list of applicable attributes for Baz');
148
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
154      {
155          my $attr;
156          lives_ok {
157              $attr = Bar->meta->remove_attribute('$bar');
158          } '... removed the $bar attribute successfully';
159          is($attr, $BAR_ATTR, '... got the right attribute back for Bar');
160
161          ok(!Bar->meta->has_attribute('$bar'), '... Bar no longer has $bar attribute');
162
163          ok(!Bar->meta->has_method('bar'), '... a accessor has been removed');
164      }
165
166      is_deeply(
167          [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
168          [
169              $BAR_ATTR_2,
170              $FOO_ATTR,
171          ],
172          '... got the right list of applicable attributes for Baz');
173
174      is_deeply(
175          [ map { $_->associated_class } sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
176          [ Foo->meta, Foo->meta ],
177          '... got the right list of associated classes from the applicable attributes for Baz');
178
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
186 }
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 {
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 {
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';
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
260 }