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