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
|
use Test::More 'no_plan';
package MyBase;
use Class::Std;
{
my %name : ATTR( :name<name> );
my %rank : ATTR( name => 'rank' :set('RANK') );
my %snum : ATTR( :name<snum> );
sub verify :CUMULATIVE {
my ($self) = @_;
my $ident = ident $self;
::is $name{$ident}, 'MyBase::name' => 'MyBase::name initialized';
::is $rank{$ident}, 'MyBase::rank' => 'MyBase::rank initialized';
::is $snum{$ident}, 'MyBase::snum' => 'MyBase::snum initialized';
}
}
package Der;
use Class::Std;
use base qw( MyBase );
{
my %name : ATTR( :name<name> );
my %rank : ATTR( name => 'rank' );
my %snum : ATTR( :name('snum') :get<sernum> );
sub verify :CUMULATIVE {
my ($self) = @_;
my $ident = ident $self;
::is $name{$ident}, 'MyBase::name' => 'Der::name initialized';
::is $rank{$ident}, 'generic rank' => 'Der::rank initialized';
::is $snum{$ident}, 'Der::snum' => 'Der::snum initialized';
}
}
package main;
my $obj = MyBase->new({
name => 'MyBase::name',
snum => 'MyBase::snum',
rank => 'generic rank',
MyBase => {
rank => 'MyBase::rank',
}
});
$obj->verify();
ok eval { $obj->set_RANK('new rank'); 1; } => 'set_RANK defined';
ok !eval { $obj->set_rank('new rank'); 1; } => 'set_rank not defined';
my $derobj = Der->new({
name => 'MyBase::name',
snum => 'MyBase::snum',
rank => 'generic rank',
MyBase => {
rank => 'MyBase::rank',
},
Der => {
snum => 'Der::snum',
},
});
$derobj->verify();
is $derobj->get_name(), 'MyBase::name' => 'Der name read accessor';
is $derobj->get_rank(), 'generic rank' => 'Der rank read accessor';
is $derobj->get_sernum(), 'Der::snum' => 'Der rank read accessor';
$derobj->set_rank('new rank');
is $derobj->get_rank(), 'new rank' => 'Der rank write accessor';
eval { $derobj->setname('new name') };
ok $@ =~ m/\ACan't locate object method "setname" via package "Der"/
=> 'Read only name attribute';
my $der2 = Der->new({
name => 'MyBase::name',
snum => 'MyBase::snum',
rank => 'generic rank',
MyBase => {
rank => 'MyBase::rank',
},
Der => {
snum => 0,
},
});
is( $der2->get_sernum(), 0, 'false values allowable as attribute parameters' );
|
