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