Commit | Line | Data |
b1897d4d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
742fb371 |
6 | use Scalar::Util; |
7 | |
8 | use Test::More tests => 29; |
b1897d4d |
9 | |
10 | BEGIN { |
11 | use_ok('Class::MOP'); |
12 | } |
13 | |
14 | =pod |
15 | |
16 | This tests that when an attribute of the same name |
17 | is added to a class, that it will remove the old |
18 | one first. |
19 | |
20 | =cut |
21 | |
22 | { |
23 | package Foo; |
24 | use metaclass; |
25 | |
26 | Foo->meta->add_attribute('bar' => |
27 | reader => 'get_bar', |
28 | writer => 'set_bar', |
29 | ); |
30 | |
31 | ::can_ok('Foo', 'get_bar'); |
32 | ::can_ok('Foo', 'set_bar'); |
33 | ::ok(Foo->meta->has_attribute('bar'), '... Foo has the attribute bar'); |
34 | |
35 | my $bar_attr = Foo->meta->get_attribute('bar'); |
36 | |
37 | ::is($bar_attr->reader, 'get_bar', '... the bar attribute has the reader get_bar'); |
38 | ::is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar'); |
39 | ::is($bar_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta'); |
40 | |
742fb371 |
41 | ::is($bar_attr->get_read_method, 'get_bar', '... $attr does have an read method'); |
42 | ::is($bar_attr->get_write_method, 'set_bar', '... $attr does have an write method'); |
43 | |
44 | { |
45 | my $reader = $bar_attr->get_read_method_ref; |
46 | my $writer = $bar_attr->get_write_method_ref; |
47 | |
48 | ::isa_ok($reader, 'Class::MOP::Method'); |
49 | ::isa_ok($writer, 'Class::MOP::Method'); |
50 | |
51 | ::is(Scalar::Util::reftype($reader->body), 'CODE', '... it is a plain old sub'); |
52 | ::is(Scalar::Util::reftype($writer->body), 'CODE', '... it is a plain old sub'); |
53 | } |
54 | |
b1897d4d |
55 | Foo->meta->add_attribute('bar' => |
56 | reader => 'assign_bar' |
57 | ); |
58 | |
59 | ::ok(!Foo->can('get_bar'), '... Foo no longer has the get_bar method'); |
60 | ::ok(!Foo->can('set_bar'), '... Foo no longer has the set_bar method'); |
61 | ::can_ok('Foo', 'assign_bar'); |
62 | ::ok(Foo->meta->has_attribute('bar'), '... Foo still has the attribute bar'); |
63 | |
64 | my $bar_attr2 = Foo->meta->get_attribute('bar'); |
65 | |
742fb371 |
66 | ::is($bar_attr2->get_read_method, 'assign_bar', '... $attr does have an read method'); |
67 | ::ok(!$bar_attr2->get_write_method, '... $attr does have an write method'); |
68 | |
69 | { |
70 | my $reader = $bar_attr2->get_read_method_ref; |
71 | my $writer = $bar_attr2->get_write_method_ref; |
72 | |
73 | ::isa_ok($reader, 'Class::MOP::Method'); |
74 | ::ok(!Scalar::Util::blessed($writer), '... the writer method is not blessed though'); |
75 | |
76 | ::is(Scalar::Util::reftype($reader->body), 'CODE', '... it is a plain old sub'); |
77 | ::is(Scalar::Util::reftype($writer), 'CODE', '... it is a plain old sub'); |
78 | } |
79 | |
b1897d4d |
80 | ::isnt($bar_attr, $bar_attr2, '... this is a new bar attribute'); |
81 | ::isnt($bar_attr->associated_class, Foo->meta, '... and the old bar attribute is no longer associated with Foo->meta'); |
82 | |
83 | ::is($bar_attr2->associated_class, Foo->meta, '... and the new bar attribute *is* associated with Foo->meta'); |
84 | |
85 | ::isnt($bar_attr2->reader, 'get_bar', '... the bar attribute no longer has the reader get_bar'); |
86 | ::isnt($bar_attr2->reader, 'set_bar', '... the bar attribute no longer has the reader set_bar'); |
87 | ::is($bar_attr2->reader, 'assign_bar', '... the bar attribute now has the reader assign_bar'); |
88 | } |
89 | |