Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Fatal; |
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 | ::is( ::exception { |
35 | $meta->add_attribute($FOO_ATTR); |
36 | }, undef, '... 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 | ::is( ::exception { |
43 | $meta->add_attribute($BAR_ATTR_2); |
44 | }, undef, '... 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 | ::is( ::exception { |
56 | $meta->add_attribute($BAR_ATTR); |
57 | }, undef, '... 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 | ::is( ::exception { |
74 | $meta->add_attribute($BAZ_ATTR); |
75 | }, undef, '... 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->get_all_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->get_all_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 | is( exception { |
131 | $attr = $meta->remove_attribute('$baz'); |
132 | }, undef, '... 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->get_all_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->get_all_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 | is( exception { |
157 | $attr = Bar->meta->remove_attribute('$bar'); |
158 | }, undef, '... 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->get_all_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->get_all_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 | is( exception { |
182 | $val = $meta->remove_attribute('$blammo'); |
183 | }, undef, '... 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 | ::is( ::exception { |
195 | $meta->add_attribute($FOO_ATTR_2); |
196 | }, undef, '... we added an attribute to Buzz successfully' ); |
197 | |
198 | ::is( ::exception { |
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 | }, undef, '... we added an attribute to Buzz successfully' ); |
209 | |
210 | ::is( ::exception { |
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 | }, undef, '... we added an attribute to Buzz successfully' ); |
222 | |
223 | ::is( ::exception { |
224 | $meta->add_method(build_foo => sub{ blessed shift; }); |
225 | }, undef, '... we added a method to Buzz successfully' ); |
226 | } |
227 | |
228 | |
229 | |
230 | for(1 .. 2){ |
231 | my $buzz; |
232 | ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' ); |
233 | ::is($buzz->foo, 'Buzz', '...foo builder works as expected'); |
234 | ::ok(!$buzz->has_bar, '...bar is not set'); |
235 | ::is($buzz->bar, undef, '...bar returns undef'); |
236 | ::ok(!$buzz->has_bar, '...bar was not autovivified'); |
237 | |
238 | $buzz->bar(undef); |
239 | ::ok($buzz->has_bar, '...bar is set'); |
240 | ::is($buzz->bar, undef, '...bar is undef'); |
241 | $buzz->clear_bar; |
242 | ::ok(!$buzz->has_bar, '...bar is no longerset'); |
243 | |
244 | my $buzz2; |
245 | ::is( ::exception { $buzz2 = Buzz->meta->new_object('$bar' => undef) }, undef, '...Buzz instantiated successfully' ); |
246 | ::ok($buzz2->has_bar, '...bar is set'); |
247 | ::is($buzz2->bar, undef, '...bar is undef'); |
248 | |
249 | my $buzz3; |
250 | ::is( ::exception { $buzz3 = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' ); |
251 | ::ok($buzz3->has_bah, '...bah is set'); |
252 | ::is($buzz3->bah, 'BAH', '...bah returns "BAH" '); |
253 | |
254 | my $buzz4; |
255 | ::is( ::exception { $buzz4 = Buzz->meta->new_object('$bah' => undef) }, undef, '...Buzz instantiated successfully' ); |
256 | ::ok($buzz4->has_bah, '...bah is set'); |
257 | ::is($buzz4->bah, undef, '...bah is undef'); |
258 | |
259 | Buzz->meta->make_immutable(); |
260 | } |
261 | |
262 | done_testing; |