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