add test that requires Moose -- skips if moose is not installed.
[gitmo/Class-MOP.git] / t / 020_attribute.t
CommitLineData
2eb717d5 1use strict;
2use warnings;
3
742fb371 4use Scalar::Util 'reftype', 'blessed';
5
ed337aad 6use Test::More tests => 104;
2eb717d5 7use Test::Exception;
8
988fb42e 9use Class::MOP;
10use Class::MOP::Attribute;
ed337aad 11use Class::MOP::Method;
988fb42e 12
13
14dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class method};
15
2eb717d5 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');
7b31baf4 22 ok($attr->has_init_arg, '... $attr does have an init_arg');
1d68af04 23 is($attr->init_arg, '$foo', '... $attr init_arg is the name');
24
2eb717d5 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');
1d68af04 28 ok(!$attr->has_default, '... $attr does not have an default');
29 ok(!$attr->has_builder, '... $attr does not have a builder');
30
def5c0b5 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
a27ae83f 42 my $class = Class::MOP::Class->initialize('Foo');
43 isa_ok($class, 'Class::MOP::Class');
1d68af04 44
a27ae83f 45 lives_ok {
46 $attr->attach_to_class($class);
47 } '... attached a class successfully';
1d68af04 48
a27ae83f 49 is($attr->associated_class, $class, '... the class was associated correctly');
742fb371 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
def5c0b5 58 ok(blessed($reader), '... it is a plain old sub');
59 ok(blessed($writer), '... it is a plain old sub');
742fb371 60
def5c0b5 61 isa_ok($reader, 'Class::MOP::Method');
62 isa_ok($writer, 'Class::MOP::Method');
742fb371 63 }
1d68af04 64
5659d76e 65 my $attr_clone = $attr->clone();
66 isa_ok($attr_clone, 'Class::MOP::Attribute');
67 isnt($attr, $attr_clone, '... but they are different instances');
1d68af04 68
a27ae83f 69 is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
1d68af04 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
5659d76e 73 is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5 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');
1d68af04 84
2eb717d5 85 ok($attr->has_init_arg, '... $attr does have an init_arg');
86 is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
1d68af04 87 ok($attr->has_default, '... $attr does have an default');
2eb717d5 88 is($attr->default, 'BAR', '... $attr->default == BAR');
1d68af04 89 ok(!$attr->has_builder, '... $attr does not have a builder');
90
2eb717d5 91 ok(!$attr->has_accessor, '... $attr does not have an accessor');
92 ok(!$attr->has_reader, '... $attr does not have an reader');
1d68af04 93 ok(!$attr->has_writer, '... $attr does not have an writer');
742fb371 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 }
1d68af04 108
5659d76e 109 my $attr_clone = $attr->clone();
110 isa_ok($attr_clone, 'Class::MOP::Attribute');
111 isnt($attr, $attr_clone, '... but they are different instances');
1d68af04 112
a27ae83f 113 is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
1d68af04 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');
2eb717d5 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');
1d68af04 129
2eb717d5 130 ok($attr->has_init_arg, '... $attr does have an init_arg');
131 is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
1d68af04 132 ok($attr->has_default, '... $attr does have an default');
2eb717d5 133 is($attr->default, 'BAR', '... $attr->default == BAR');
134
1d68af04 135 ok($attr->has_accessor, '... $attr does have an accessor');
2eb717d5 136 is($attr->accessor, 'foo', '... $attr->accessor == foo');
1d68af04 137
2eb717d5 138 ok(!$attr->has_reader, '... $attr does not have an reader');
1d68af04 139 ok(!$attr->has_writer, '... $attr does not have an writer');
742fb371 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 }
1d68af04 154
5659d76e 155 my $attr_clone = $attr->clone();
156 isa_ok($attr_clone, 'Class::MOP::Attribute');
a740253a 157 isnt($attr, $attr_clone, '... but they are different instances');
1d68af04 158
159 is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5 160}
161
162{
163 my $attr = Class::MOP::Attribute->new('$foo', (
164 reader => 'get_foo',
1d68af04 165 writer => 'set_foo',
2eb717d5 166 init_arg => '-foo',
167 default => 'BAR'
168 ));
169 isa_ok($attr, 'Class::MOP::Attribute');
170
171 is($attr->name, '$foo', '... $attr->name == $foo');
1d68af04 172
2eb717d5 173 ok($attr->has_init_arg, '... $attr does have an init_arg');
174 is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
1d68af04 175 ok($attr->has_default, '... $attr does have an default');
2eb717d5 176 is($attr->default, 'BAR', '... $attr->default == BAR');
177
178 ok($attr->has_reader, '... $attr does have an reader');
1d68af04 179 is($attr->reader, 'get_foo', '... $attr->reader == get_foo');
2eb717d5 180 ok($attr->has_writer, '... $attr does have an writer');
1d68af04 181 is($attr->writer, 'set_foo', '... $attr->writer == set_foo');
182
183 ok(!$attr->has_accessor, '... $attr does not have an accessor');
742fb371 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 }
2eb717d5 198
5659d76e 199 my $attr_clone = $attr->clone();
200 isa_ok($attr_clone, 'Class::MOP::Attribute');
a740253a 201 isnt($attr, $attr_clone, '... but they are different instances');
1d68af04 202
203 is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5 204}
22286063 205
206{
207 my $attr = Class::MOP::Attribute->new('$foo');
208 isa_ok($attr, 'Class::MOP::Attribute');
1d68af04 209
22286063 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');
1d68af04 213
22286063 214 isnt($attr->name, $attr_clone->name, '... we changes the name parameter');
1d68af04 215
22286063 216 is($attr->name, '$foo', '... $attr->name == $foo');
1d68af04 217 is($attr_clone->name, '$bar', '... $attr_clone->name == $bar');
22286063 218}
219
1d68af04 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}
ed337aad 229
230{
231 for my $value ({}, bless({}, 'Foo')) {
232 throws_ok {
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 lives_ok {
241 my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar');
242 $attr = Class::MOP::Attribute->new('$foo', default => $meth);
243 } 'Class::MOP::Methods accepted as default';
244
245 is($attr->default(42), 42, 'passthrough for default on attribute');
246}