Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Fatal; |
6 | |
7 | use Class::MOP; |
8 | |
9 | { |
10 | package Point; |
11 | use metaclass; |
12 | |
13 | Point->meta->add_attribute('x' => ( |
14 | reader => 'x', |
15 | init_arg => 'x' |
16 | )); |
17 | |
18 | Point->meta->add_attribute('y' => ( |
19 | accessor => 'y', |
20 | init_arg => 'y' |
21 | )); |
22 | |
23 | sub new { |
24 | my $class = shift; |
25 | bless $class->meta->new_object(@_) => $class; |
26 | } |
27 | |
28 | sub clear { |
29 | my $self = shift; |
30 | $self->{'x'} = 0; |
31 | $self->{'y'} = 0; |
32 | } |
33 | |
34 | package Point3D; |
35 | our @ISA = ('Point'); |
36 | |
37 | Point3D->meta->add_attribute('z' => ( |
38 | default => 123 |
39 | )); |
40 | |
41 | sub clear { |
42 | my $self = shift; |
43 | $self->{'z'} = 0; |
44 | $self->SUPER::clear(); |
45 | } |
46 | } |
47 | |
48 | isa_ok(Point->meta, 'Class::MOP::Class'); |
49 | isa_ok(Point3D->meta, 'Class::MOP::Class'); |
50 | |
51 | # ... test the classes themselves |
52 | |
53 | my $point = Point->new('x' => 2, 'y' => 3); |
54 | isa_ok($point, 'Point'); |
55 | |
56 | can_ok($point, 'x'); |
57 | can_ok($point, 'y'); |
58 | can_ok($point, 'clear'); |
59 | |
60 | { |
61 | my $meta = $point->meta; |
62 | is($meta, Point->meta(), '... got the meta from the instance too'); |
63 | } |
64 | |
65 | is($point->y, 3, '... the y attribute was initialized correctly through the metaobject'); |
66 | |
67 | $point->y(42); |
68 | is($point->y, 42, '... the y attribute was set properly with the accessor'); |
69 | |
70 | is($point->x, 2, '... the x attribute was initialized correctly through the metaobject'); |
71 | |
72 | isnt( exception { |
73 | $point->x(42); |
74 | }, undef, '... cannot write to a read-only accessor' ); |
75 | is($point->x, 2, '... the x attribute was not altered'); |
76 | |
77 | $point->clear(); |
78 | |
79 | is($point->y, 0, '... the y attribute was cleared correctly'); |
80 | is($point->x, 0, '... the x attribute was cleared correctly'); |
81 | |
82 | my $point3d = Point3D->new('x' => 1, 'y' => 2, 'z' => 3); |
83 | isa_ok($point3d, 'Point3D'); |
84 | isa_ok($point3d, 'Point'); |
85 | |
86 | { |
87 | my $meta = $point3d->meta; |
88 | is($meta, Point3D->meta(), '... got the meta from the instance too'); |
89 | } |
90 | |
91 | can_ok($point3d, 'x'); |
92 | can_ok($point3d, 'y'); |
93 | can_ok($point3d, 'clear'); |
94 | |
95 | is($point3d->x, 1, '... the x attribute was initialized correctly through the metaobject'); |
96 | is($point3d->y, 2, '... the y attribute was initialized correctly through the metaobject'); |
97 | is($point3d->{'z'}, 3, '... the z attribute was initialized correctly through the metaobject'); |
98 | |
99 | { |
100 | my $point3d = Point3D->new(); |
101 | isa_ok($point3d, 'Point3D'); |
102 | |
103 | is($point3d->x, undef, '... the x attribute was not initialized'); |
104 | is($point3d->y, undef, '... the y attribute was not initialized'); |
105 | is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject'); |
106 | |
107 | } |
108 | |
109 | done_testing; |