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