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