Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Scalar::Util 'reftype', 'blessed'; |
5 | |
6 | use Test::More; |
7 | use Test::Fatal; |
8 | |
9 | use Class::MOP; |
10 | use Class::MOP::Attribute; |
11 | use Class::MOP::Method; |
12 | |
13 | |
14 | isnt( exception { Class::MOP::Attribute->name }, undef, q{... can't call name() as a class method} ); |
15 | |
16 | |
17 | { |
18 | my $attr = Class::MOP::Attribute->new('$foo'); |
19 | isa_ok($attr, 'Class::MOP::Attribute'); |
20 | |
21 | is($attr->name, '$foo', '... $attr->name == $foo'); |
22 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
23 | is($attr->init_arg, '$foo', '... $attr init_arg is the name'); |
24 | |
25 | ok(!$attr->has_accessor, '... $attr does not have an accessor'); |
26 | ok(!$attr->has_reader, '... $attr does not have an reader'); |
27 | ok(!$attr->has_writer, '... $attr does not have an writer'); |
28 | ok(!$attr->has_default, '... $attr does not have an default'); |
29 | ok(!$attr->has_builder, '... $attr does not have a builder'); |
30 | |
31 | { |
32 | my $reader = $attr->get_read_method_ref; |
33 | my $writer = $attr->get_write_method_ref; |
34 | |
35 | ok(!blessed($reader), '... it is a plain old sub'); |
36 | ok(!blessed($writer), '... it is a plain old sub'); |
37 | |
38 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
39 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
40 | } |
41 | |
42 | my $class = Class::MOP::Class->initialize('Foo'); |
43 | isa_ok($class, 'Class::MOP::Class'); |
44 | |
45 | is( exception { |
46 | $attr->attach_to_class($class); |
47 | }, undef, '... attached a class successfully' ); |
48 | |
49 | is($attr->associated_class, $class, '... the class was associated correctly'); |
50 | |
51 | ok(!$attr->get_read_method, '... $attr does not have an read method'); |
52 | ok(!$attr->get_write_method, '... $attr does not have an write method'); |
53 | |
54 | { |
55 | my $reader = $attr->get_read_method_ref; |
56 | my $writer = $attr->get_write_method_ref; |
57 | |
58 | ok(blessed($reader), '... it is a plain old sub'); |
59 | ok(blessed($writer), '... it is a plain old sub'); |
60 | |
61 | isa_ok($reader, 'Class::MOP::Method'); |
62 | isa_ok($writer, 'Class::MOP::Method'); |
63 | } |
64 | |
65 | my $attr_clone = $attr->clone(); |
66 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
67 | isnt($attr, $attr_clone, '... but they are different instances'); |
68 | |
69 | is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though'); |
70 | is($attr->associated_class, $class, '... the associated classes are the same though'); |
71 | is($attr_clone->associated_class, $class, '... the associated classes are the same though'); |
72 | |
73 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
74 | } |
75 | |
76 | { |
77 | my $attr = Class::MOP::Attribute->new('$foo', ( |
78 | init_arg => '-foo', |
79 | default => 'BAR' |
80 | )); |
81 | isa_ok($attr, 'Class::MOP::Attribute'); |
82 | |
83 | is($attr->name, '$foo', '... $attr->name == $foo'); |
84 | |
85 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
86 | is($attr->init_arg, '-foo', '... $attr->init_arg == -foo'); |
87 | ok($attr->has_default, '... $attr does have an default'); |
88 | is($attr->default, 'BAR', '... $attr->default == BAR'); |
89 | ok(!$attr->has_builder, '... $attr does not have a builder'); |
90 | |
91 | ok(!$attr->has_accessor, '... $attr does not have an accessor'); |
92 | ok(!$attr->has_reader, '... $attr does not have an reader'); |
93 | ok(!$attr->has_writer, '... $attr does not have an writer'); |
94 | |
95 | ok(!$attr->get_read_method, '... $attr does not have an read method'); |
96 | ok(!$attr->get_write_method, '... $attr does not have an write method'); |
97 | |
98 | { |
99 | my $reader = $attr->get_read_method_ref; |
100 | my $writer = $attr->get_write_method_ref; |
101 | |
102 | ok(!blessed($reader), '... it is a plain old sub'); |
103 | ok(!blessed($writer), '... it is a plain old sub'); |
104 | |
105 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
106 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
107 | } |
108 | |
109 | my $attr_clone = $attr->clone(); |
110 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
111 | isnt($attr, $attr_clone, '... but they are different instances'); |
112 | |
113 | is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though'); |
114 | is($attr->associated_class, undef, '... the associated class is actually undef'); |
115 | is($attr_clone->associated_class, undef, '... the associated class is actually undef'); |
116 | |
117 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
118 | } |
119 | |
120 | { |
121 | my $attr = Class::MOP::Attribute->new('$foo', ( |
122 | accessor => 'foo', |
123 | init_arg => '-foo', |
124 | default => 'BAR' |
125 | )); |
126 | isa_ok($attr, 'Class::MOP::Attribute'); |
127 | |
128 | is($attr->name, '$foo', '... $attr->name == $foo'); |
129 | |
130 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
131 | is($attr->init_arg, '-foo', '... $attr->init_arg == -foo'); |
132 | ok($attr->has_default, '... $attr does have an default'); |
133 | is($attr->default, 'BAR', '... $attr->default == BAR'); |
134 | |
135 | ok($attr->has_accessor, '... $attr does have an accessor'); |
136 | is($attr->accessor, 'foo', '... $attr->accessor == foo'); |
137 | |
138 | ok(!$attr->has_reader, '... $attr does not have an reader'); |
139 | ok(!$attr->has_writer, '... $attr does not have an writer'); |
140 | |
141 | is($attr->get_read_method, 'foo', '... $attr does not have an read method'); |
142 | is($attr->get_write_method, 'foo', '... $attr does not have an write method'); |
143 | |
144 | { |
145 | my $reader = $attr->get_read_method_ref; |
146 | my $writer = $attr->get_write_method_ref; |
147 | |
148 | ok(!blessed($reader), '... it is not a plain old sub'); |
149 | ok(!blessed($writer), '... it is not a plain old sub'); |
150 | |
151 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
152 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
153 | } |
154 | |
155 | my $attr_clone = $attr->clone(); |
156 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
157 | isnt($attr, $attr_clone, '... but they are different instances'); |
158 | |
159 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
160 | } |
161 | |
162 | { |
163 | my $attr = Class::MOP::Attribute->new('$foo', ( |
164 | reader => 'get_foo', |
165 | writer => 'set_foo', |
166 | init_arg => '-foo', |
167 | default => 'BAR' |
168 | )); |
169 | isa_ok($attr, 'Class::MOP::Attribute'); |
170 | |
171 | is($attr->name, '$foo', '... $attr->name == $foo'); |
172 | |
173 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
174 | is($attr->init_arg, '-foo', '... $attr->init_arg == -foo'); |
175 | ok($attr->has_default, '... $attr does have an default'); |
176 | is($attr->default, 'BAR', '... $attr->default == BAR'); |
177 | |
178 | ok($attr->has_reader, '... $attr does have an reader'); |
179 | is($attr->reader, 'get_foo', '... $attr->reader == get_foo'); |
180 | ok($attr->has_writer, '... $attr does have an writer'); |
181 | is($attr->writer, 'set_foo', '... $attr->writer == set_foo'); |
182 | |
183 | ok(!$attr->has_accessor, '... $attr does not have an accessor'); |
184 | |
185 | is($attr->get_read_method, 'get_foo', '... $attr does not have an read method'); |
186 | is($attr->get_write_method, 'set_foo', '... $attr does not have an write method'); |
187 | |
188 | { |
189 | my $reader = $attr->get_read_method_ref; |
190 | my $writer = $attr->get_write_method_ref; |
191 | |
192 | ok(!blessed($reader), '... it is not a plain old sub'); |
193 | ok(!blessed($writer), '... it is not a plain old sub'); |
194 | |
195 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
196 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
197 | } |
198 | |
199 | my $attr_clone = $attr->clone(); |
200 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
201 | isnt($attr, $attr_clone, '... but they are different instances'); |
202 | |
203 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
204 | } |
205 | |
206 | { |
207 | my $attr = Class::MOP::Attribute->new('$foo'); |
208 | isa_ok($attr, 'Class::MOP::Attribute'); |
209 | |
210 | my $attr_clone = $attr->clone('name' => '$bar'); |
211 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
212 | isnt($attr, $attr_clone, '... but they are different instances'); |
213 | |
214 | isnt($attr->name, $attr_clone->name, '... we changes the name parameter'); |
215 | |
216 | is($attr->name, '$foo', '... $attr->name == $foo'); |
217 | is($attr_clone->name, '$bar', '... $attr_clone->name == $bar'); |
218 | } |
219 | |
220 | { |
221 | my $attr = Class::MOP::Attribute->new('$foo', (builder => 'foo_builder')); |
222 | isa_ok($attr, 'Class::MOP::Attribute'); |
223 | |
224 | ok(!$attr->has_default, '... $attr does not have a default'); |
225 | ok($attr->has_builder, '... $attr does have a builder'); |
226 | is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder'); |
227 | |
228 | } |
229 | |
230 | { |
231 | for my $value ({}, bless({}, 'Foo')) { |
232 | like( exception { |
233 | Class::MOP::Attribute->new('$foo', default => $value); |
234 | }, qr/References are not allowed as default values/ ); |
235 | } |
236 | } |
237 | |
238 | { |
239 | my $attr; |
240 | is( exception { |
241 | my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar'); |
242 | $attr = Class::MOP::Attribute->new('$foo', default => $meth); |
243 | }, undef, 'Class::MOP::Methods accepted as default' ); |
244 | |
245 | is($attr->default(42), 42, 'passthrough for default on attribute'); |
246 | } |
247 | |
248 | done_testing; |