1use Test::More 'no_plan';
2
3package MyBase;
4use Class::Std;
5{
6    my %name : ATTR( :name<name>    );
7    my %rank : ATTR( name => 'rank' :set('RANK')   );
8    my %snum : ATTR( :name<snum>    );
9
10    sub verify :CUMULATIVE {
11        my ($self) = @_;
12        my $ident = ident $self;
13
14        ::is $name{$ident}, 'MyBase::name'    => 'MyBase::name initialized';
15        ::is $rank{$ident}, 'MyBase::rank'    => 'MyBase::rank initialized';
16        ::is $snum{$ident}, 'MyBase::snum'    => 'MyBase::snum initialized';
17    }
18}
19
20package Der;
21use Class::Std;
22use base qw( MyBase );
23{
24    my %name : ATTR( :name<name>                 );
25    my %rank : ATTR( name => 'rank'              );
26    my %snum : ATTR( :name('snum')  :get<sernum> );
27
28    sub verify :CUMULATIVE {
29        my ($self) = @_;
30        my $ident = ident $self;
31
32        ::is $name{$ident}, 'MyBase::name'   => 'Der::name initialized';
33        ::is $rank{$ident}, 'generic rank'   => 'Der::rank initialized';
34        ::is $snum{$ident}, 'Der::snum'      => 'Der::snum initialized';
35    }
36}
37
38package main;
39
40my $obj = MyBase->new({
41    name => 'MyBase::name',
42    snum => 'MyBase::snum',
43    rank => 'generic rank',
44    MyBase => {
45        rank => 'MyBase::rank',
46    }
47});
48
49$obj->verify();
50
51ok eval { $obj->set_RANK('new rank'); 1; }      =>  'set_RANK defined';
52ok !eval { $obj->set_rank('new rank'); 1; }     =>  'set_rank not defined';
53
54my $derobj = Der->new({
55    name => 'MyBase::name',
56    snum => 'MyBase::snum',
57    rank => 'generic rank',
58    MyBase => {
59        rank => 'MyBase::rank',
60    },
61    Der => {
62        snum => 'Der::snum',
63    },
64});
65
66$derobj->verify();
67
68is $derobj->get_name(), 'MyBase::name'  => 'Der name read accessor';
69is $derobj->get_rank(), 'generic rank'  => 'Der rank read accessor';
70is $derobj->get_sernum(), 'Der::snum'     => 'Der rank read accessor';
71
72$derobj->set_rank('new rank');
73is $derobj->get_rank(), 'new rank'      => 'Der rank write accessor';
74
75eval { $derobj->setname('new name') };
76ok $@ =~ m/\ACan't locate object method "setname" via package "Der"/
77                                        => 'Read only name attribute';
78
79my $der2 = Der->new({
80    name => 'MyBase::name',
81    snum => 'MyBase::snum',
82    rank => 'generic rank',
83    MyBase => {
84        rank => 'MyBase::rank',
85    },
86    Der => {
87        snum => 0,
88    },
89});
90is( $der2->get_sernum(), 0, 'false values allowable as attribute parameters' );
91