eval
q{
package MyBase;
use Class::Std::Fast;
{
my %name : ATTR( :init_arg<name> :get<name> );
my %rank : ATTR( init_arg => 'rank' :get<rank> :set<rank> );
my %snum : ATTR( :init_arg('snum') :get<snum> );
my %priv : ATTR;
my %def : ATTR( :default<MyBase::def> :get<default> );
my %dval : ATTR( :default('dval') :get<dval> );
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
::is ref $arg_ref, 'HASH' => 'Args passed to MyBase::BUILD in hash-ref';
::is ident $self, $ident => 'Identity correct in MyBase::BUILD';
$priv{$ident}
=
$arg_ref
->{priv};
::is
$priv
{
$ident
},
'MyBase::priv'
=>
'MyBase priv arg unpacked correctly'
;
$snum
{
$ident
} =
$arg_ref
->{snum} .
'!'
;
::is
$snum
{
$ident
},
'MyBase::snum!'
=>
'MyBase snum arg unpacked correctly'
;
}
sub
DEMOLISH {
my
(
$self
,
$ident
) =
@_
;
::is ident
$self
,
$ident
=>
'Identity correct in MyBase::DEMOLISH'
}
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'
;
::is
$priv
{
$ident
},
'MyBase::priv'
=>
'MyBase::name initialized'
;
::is
$def
{
$ident
},
'MyBase::def'
=>
'MyBase::def initialized'
;
}
sub
rest : RESTRICTED {
::ok 1,
'Accessed restricted'
;
}
Class::Std::Fast::initialize;
}
{
my
%name
: ATTR( :init_arg<name> );
my
%rank
: ATTR(
init_arg
=>
'rank'
);
my
%snum
: ATTR( :init_arg(
'snum'
) :get<snum> );
my
%priv
: ATTR( :init_arg<priv> :get<priv> );
my
%def
: ATTR( :init_arg<def> :
default
<
default
def> :get<
default
> );
sub
BUILD {
my
(
$self
,
$ident
,
$arg_ref
) =
@_
;
::is
ref
$arg_ref
,
'HASH'
=>
'Args passed to Der::BUILD in hash-ref'
;
::is ident
$self
,
$ident
=>
'Identity correct in Der::BUILD'
;
}
sub
DEMOLISH {
my
(
$self
,
$ident
) =
@_
;
::is ident
$self
,
$ident
=>
'Identity correct in Der::DEMOLISH'
}
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'
;
::is
$priv
{
$ident
},
'Der::priv'
=>
'Der::name initialized'
;
::is
$def
{
$ident
},
'Der::def'
=>
'Der::def initialized'
;
$self
->rest();
}
Class::Std::Fast::initialize;
}
};
my
$obj
= MyBase->new({
name
=>
'MyBase::name'
,
snum
=>
'MyBase::snum'
,
rank
=>
'generic rank'
,
priv
=>
'generic priv'
,
MyBase
=> {
rank
=>
'MyBase::rank'
,
priv
=>
'MyBase::priv'
,
}
});
$obj
->verify();
my
$derobj
= Der->new({
name
=>
'MyBase::name'
,
snum
=>
'MyBase::snum'
,
rank
=>
'generic rank'
,
priv
=>
'generic priv'
,
MyBase
=> {
rank
=>
'MyBase::rank'
,
priv
=>
'MyBase::priv'
,
},
Der
=> {
snum
=>
'Der::snum'
,
priv
=>
'Der::priv'
,
def
=>
'Der::def'
,
},
});
$derobj
->verify();
is
$derobj
->get_name(),
'MyBase::name'
=>
'Der name read accessor'
;
is
$derobj
->get_rank(),
'MyBase::rank'
=>
'Der rank read accessor'
;
is
$derobj
->get_snum(),
'Der::snum'
=>
'Der rank read accessor'
;
is
$derobj
->get_priv(),
'Der::priv'
=>
'Der priv 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'
,
priv
=>
'generic priv'
,
MyBase
=> {
rank
=>
'MyBase::rank'
,
priv
=>
'MyBase::priv'
,
},
Der
=> {
snum
=> 0,
priv
=>
'Der::priv'
,
},
});
is(
$der2
->get_snum(), 0,
'false values allowable as attribute parameters'
);
is(
$der2
->get_dval,
'dval'
,
'default values evaled correctly'
);
print
"# DONE - now comes the cleanup...\n"
;