6 use Scalar::Util 'reftype', 'blessed';
8 use Test::More tests => 100;
12 use Class::MOP::Attribute;
15 dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class method};
19 my $attr = Class::MOP::Attribute->new('$foo');
20 isa_ok($attr, 'Class::MOP::Attribute');
22 is($attr->name, '$foo', '... $attr->name == $foo');
23 ok($attr->has_init_arg, '... $attr does have an init_arg');
24 is($attr->init_arg, '$foo', '... $attr init_arg is the name');
26 ok(!$attr->has_accessor, '... $attr does not have an accessor');
27 ok(!$attr->has_reader, '... $attr does not have an reader');
28 ok(!$attr->has_writer, '... $attr does not have an writer');
29 ok(!$attr->has_default, '... $attr does not have an default');
30 ok(!$attr->has_builder, '... $attr does not have a builder');
33 my $reader = $attr->get_read_method_ref;
34 my $writer = $attr->get_write_method_ref;
36 ok(!blessed($reader), '... it is a plain old sub');
37 ok(!blessed($writer), '... it is a plain old sub');
39 is(reftype($reader), 'CODE', '... it is a plain old sub');
40 is(reftype($writer), 'CODE', '... it is a plain old sub');
43 my $class = Class::MOP::Class->initialize('Foo');
44 isa_ok($class, 'Class::MOP::Class');
47 $attr->attach_to_class($class);
48 } '... attached a class successfully';
50 is($attr->associated_class, $class, '... the class was associated correctly');
52 ok(!$attr->get_read_method, '... $attr does not have an read method');
53 ok(!$attr->get_write_method, '... $attr does not have an write method');
56 my $reader = $attr->get_read_method_ref;
57 my $writer = $attr->get_write_method_ref;
59 ok(blessed($reader), '... it is a plain old sub');
60 ok(blessed($writer), '... it is a plain old sub');
62 isa_ok($reader, 'Class::MOP::Method');
63 isa_ok($writer, 'Class::MOP::Method');
66 my $attr_clone = $attr->clone();
67 isa_ok($attr_clone, 'Class::MOP::Attribute');
68 isnt($attr, $attr_clone, '... but they are different instances');
70 is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
71 is($attr->associated_class, $class, '... the associated classes are the same though');
72 is($attr_clone->associated_class, $class, '... the associated classes are the same though');
74 is_deeply($attr, $attr_clone, '... but they are the same inside');
78 my $attr = Class::MOP::Attribute->new('$foo', (
82 isa_ok($attr, 'Class::MOP::Attribute');
84 is($attr->name, '$foo', '... $attr->name == $foo');
86 ok($attr->has_init_arg, '... $attr does have an init_arg');
87 is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
88 ok($attr->has_default, '... $attr does have an default');
89 is($attr->default, 'BAR', '... $attr->default == BAR');
90 ok(!$attr->has_builder, '... $attr does not have a builder');
92 ok(!$attr->has_accessor, '... $attr does not have an accessor');
93 ok(!$attr->has_reader, '... $attr does not have an reader');
94 ok(!$attr->has_writer, '... $attr does not have an writer');
96 ok(!$attr->get_read_method, '... $attr does not have an read method');
97 ok(!$attr->get_write_method, '... $attr does not have an write method');
100 my $reader = $attr->get_read_method_ref;
101 my $writer = $attr->get_write_method_ref;
103 ok(!blessed($reader), '... it is a plain old sub');
104 ok(!blessed($writer), '... it is a plain old sub');
106 is(reftype($reader), 'CODE', '... it is a plain old sub');
107 is(reftype($writer), 'CODE', '... it is a plain old sub');
110 my $attr_clone = $attr->clone();
111 isa_ok($attr_clone, 'Class::MOP::Attribute');
112 isnt($attr, $attr_clone, '... but they are different instances');
114 is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
115 is($attr->associated_class, undef, '... the associated class is actually undef');
116 is($attr_clone->associated_class, undef, '... the associated class is actually undef');
118 is_deeply($attr, $attr_clone, '... but they are the same inside');
122 my $attr = Class::MOP::Attribute->new('$foo', (
127 isa_ok($attr, 'Class::MOP::Attribute');
129 is($attr->name, '$foo', '... $attr->name == $foo');
131 ok($attr->has_init_arg, '... $attr does have an init_arg');
132 is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
133 ok($attr->has_default, '... $attr does have an default');
134 is($attr->default, 'BAR', '... $attr->default == BAR');
136 ok($attr->has_accessor, '... $attr does have an accessor');
137 is($attr->accessor, 'foo', '... $attr->accessor == foo');
139 ok(!$attr->has_reader, '... $attr does not have an reader');
140 ok(!$attr->has_writer, '... $attr does not have an writer');
142 is($attr->get_read_method, 'foo', '... $attr does not have an read method');
143 is($attr->get_write_method, 'foo', '... $attr does not have an write method');
146 my $reader = $attr->get_read_method_ref;
147 my $writer = $attr->get_write_method_ref;
149 ok(!blessed($reader), '... it is not a plain old sub');
150 ok(!blessed($writer), '... it is not a plain old sub');
152 is(reftype($reader), 'CODE', '... it is a plain old sub');
153 is(reftype($writer), 'CODE', '... it is a plain old sub');
156 my $attr_clone = $attr->clone();
157 isa_ok($attr_clone, 'Class::MOP::Attribute');
158 isnt($attr, $attr_clone, '... but they are different instances');
160 is_deeply($attr, $attr_clone, '... but they are the same inside');
164 my $attr = Class::MOP::Attribute->new('$foo', (
170 isa_ok($attr, 'Class::MOP::Attribute');
172 is($attr->name, '$foo', '... $attr->name == $foo');
174 ok($attr->has_init_arg, '... $attr does have an init_arg');
175 is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
176 ok($attr->has_default, '... $attr does have an default');
177 is($attr->default, 'BAR', '... $attr->default == BAR');
179 ok($attr->has_reader, '... $attr does have an reader');
180 is($attr->reader, 'get_foo', '... $attr->reader == get_foo');
181 ok($attr->has_writer, '... $attr does have an writer');
182 is($attr->writer, 'set_foo', '... $attr->writer == set_foo');
184 ok(!$attr->has_accessor, '... $attr does not have an accessor');
186 is($attr->get_read_method, 'get_foo', '... $attr does not have an read method');
187 is($attr->get_write_method, 'set_foo', '... $attr does not have an write method');
190 my $reader = $attr->get_read_method_ref;
191 my $writer = $attr->get_write_method_ref;
193 ok(!blessed($reader), '... it is not a plain old sub');
194 ok(!blessed($writer), '... it is not a plain old sub');
196 is(reftype($reader), 'CODE', '... it is a plain old sub');
197 is(reftype($writer), 'CODE', '... it is a plain old sub');
200 my $attr_clone = $attr->clone();
201 isa_ok($attr_clone, 'Class::MOP::Attribute');
202 isnt($attr, $attr_clone, '... but they are different instances');
204 is_deeply($attr, $attr_clone, '... but they are the same inside');
208 my $attr = Class::MOP::Attribute->new('$foo');
209 isa_ok($attr, 'Class::MOP::Attribute');
211 my $attr_clone = $attr->clone('name' => '$bar');
212 isa_ok($attr_clone, 'Class::MOP::Attribute');
213 isnt($attr, $attr_clone, '... but they are different instances');
215 isnt($attr->name, $attr_clone->name, '... we changes the name parameter');
217 is($attr->name, '$foo', '... $attr->name == $foo');
218 is($attr_clone->name, '$bar', '... $attr_clone->name == $bar');
222 my $attr = Class::MOP::Attribute->new('$foo', (builder => 'foo_builder'));
223 isa_ok($attr, 'Class::MOP::Attribute');
225 ok(!$attr->has_default, '... $attr does not have a default');
226 ok($attr->has_builder, '... $attr does have a builder');
227 is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder');