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