1# if you execute this script directly it say's 2# Looks like you planned 47 tests but only ran 44. 3# because the destructos / DEMOLISH methods won't be 4# executed 5use Test::More tests => 45; 6 7eval q{ 8 package MyBase; 9 use Class::Std::Fast; 10 { 11 my %name : ATTR( :init_arg<name> :get<name> ); 12 my %rank : ATTR( init_arg => 'rank' :get<rank> :set<rank> ); 13 my %snum : ATTR( :init_arg('snum') :get<snum> ); 14 my %priv : ATTR; 15 my %def : ATTR( :default<MyBase::def> :get<default> ); 16 my %dval : ATTR( :default('dval') :get<dval> ); 17 18 sub BUILD { 19 my ($self, $ident, $arg_ref) = @_; 20 21 ::is ref $arg_ref, 'HASH' => 'Args passed to MyBase::BUILD in hash-ref'; 22 ::is ident $self, $ident => 'Identity correct in MyBase::BUILD'; 23 24 $priv{$ident} = $arg_ref->{priv}; 25 ::is $priv{$ident}, 'MyBase::priv' => 'MyBase priv arg unpacked correctly'; 26 27 $snum{$ident} = $arg_ref->{snum} . '!'; 28 ::is $snum{$ident}, 'MyBase::snum!' => 'MyBase snum arg unpacked correctly'; 29 } 30 31 sub DEMOLISH { 32 my ($self, $ident) = @_; 33 34 ::is ident $self, $ident => 'Identity correct in MyBase::DEMOLISH' 35 } 36 37 sub verify :CUMULATIVE { 38 my ($self) = @_; 39 my $ident = ident $self; 40 41 ::is $name{$ident}, 'MyBase::name' => 'MyBase::name initialized'; 42 ::is $rank{$ident}, 'MyBase::rank' => 'MyBase::rank initialized'; 43 ::is $snum{$ident}, 'MyBase::snum!' => 'MyBase::snum initialized'; 44 ::is $priv{$ident}, 'MyBase::priv' => 'MyBase::name initialized'; 45 ::is $def{$ident}, 'MyBase::def' => 'MyBase::def initialized'; 46 } 47 48 sub rest : RESTRICTED { 49 ::ok 1, 'Accessed restricted'; 50 } 51 52 Class::Std::Fast::initialize; 53 } 54 55 package Der; 56 use Class::Std::Fast; 57 use base qw( MyBase ); 58 { 59 my %name : ATTR( :init_arg<name> ); 60 my %rank : ATTR( init_arg => 'rank' ); 61 my %snum : ATTR( :init_arg('snum') :get<snum> ); 62 my %priv : ATTR( :init_arg<priv> :get<priv> ); 63 my %def : ATTR( :init_arg<def> :default<default def> :get<default> ); 64 65 sub BUILD { 66 my ($self, $ident, $arg_ref) = @_; 67 68 ::is ref $arg_ref, 'HASH' => 'Args passed to Der::BUILD in hash-ref'; 69 ::is ident $self, $ident => 'Identity correct in Der::BUILD'; 70 } 71 72 sub DEMOLISH { 73 my ($self, $ident) = @_; 74 75 ::is ident $self, $ident => 'Identity correct in Der::DEMOLISH' 76 } 77 78 sub verify :CUMULATIVE { 79 my ($self) = @_; 80 my $ident = ident $self; 81 82 ::is $name{$ident}, 'MyBase::name' => 'Der::name initialized'; 83 ::is $rank{$ident}, 'generic rank' => 'Der::rank initialized'; 84 ::is $snum{$ident}, 'Der::snum' => 'Der::snum initialized'; 85 ::is $priv{$ident}, 'Der::priv' => 'Der::name initialized'; 86 ::is $def{$ident}, 'Der::def' => 'Der::def initialized'; 87 88 $self->rest(); 89 } 90 Class::Std::Fast::initialize; 91 } 92}; 93 94package main; 95 96my $obj = MyBase->new({ 97 name => 'MyBase::name', 98 snum => 'MyBase::snum', 99 rank => 'generic rank', 100 priv => 'generic priv', 101 MyBase => { 102 rank => 'MyBase::rank', 103 priv => 'MyBase::priv', 104 } 105}); 106 107$obj->verify(); 108 109my $derobj = Der->new({ 110 name => 'MyBase::name', 111 snum => 'MyBase::snum', 112 rank => 'generic rank', 113 priv => 'generic priv', 114 MyBase => { 115 rank => 'MyBase::rank', 116 priv => 'MyBase::priv', 117 }, 118 Der => { 119 snum => 'Der::snum', 120 priv => 'Der::priv', 121 def => 'Der::def', 122 }, 123}); 124 125$derobj->verify(); 126 127is $derobj->get_name(), 'MyBase::name' => 'Der name read accessor'; 128is $derobj->get_rank(), 'MyBase::rank' => 'Der rank read accessor'; 129is $derobj->get_snum(), 'Der::snum' => 'Der rank read accessor'; 130is $derobj->get_priv(), 'Der::priv' => 'Der priv read accessor'; 131 132$derobj->set_rank('new rank'); 133is $derobj->get_rank(), 'new rank' => 'Der rank write accessor'; 134 135eval { $derobj->setname('new name') }; 136ok $@ =~ m/\ACan't locate object method "setname" via package "Der"/ 137 => 'Read only name attribute'; 138 139my $der2 = Der->new({ 140 name => 'MyBase::name', 141 snum => 'MyBase::snum', 142 rank => 'generic rank', 143 priv => 'generic priv', 144 MyBase => { 145 rank => 'MyBase::rank', 146 priv => 'MyBase::priv', 147 }, 148 Der => { 149 snum => 0, 150 priv => 'Der::priv', 151 }, 152}); 153is( $der2->get_snum(), 0, 'false values allowable as attribute parameters' ); 154 155is( $der2->get_dval, 'dval', 'default values evaled correctly' ); 156 157print "# DONE - now comes the cleanup...\n"; 158