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