1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
BEGIN { chdir 't' if -d 't' };
use strict;
use lib '../lib';
use Test::More 'no_plan';
use Data::Dumper;
my $Class = 'Object::Accessor';
my $MyClass = 'My::Class';
my $Acc = 'foo';
use_ok($Class);
### establish another package that subclasses our own
{ package My::Class;
use base 'Object::Accessor';
}
my $Object = $MyClass->new;
### check the object
{ ok( $Object, "Object created" );
isa_ok( $Object, $MyClass );
isa_ok( $Object, $Class );
}
### create an accessor
{ ok( $Object->mk_accessors( $Acc ),
"Accessor '$Acc' created" );
ok( $Object->can( $Acc ), " Object can '$Acc'" );
ok( $Object->$Acc(1), " Objects '$Acc' set" );
ok( $Object->$Acc(), " Objects '$Acc' retrieved" );
}
### check if we do the right thing when we call an accessor that's
### not a defined function in the base class, and not an accessors
### in the object either
{ my $sub = eval { $MyClass->can( $$ ); };
ok( !$sub, "No sub from non-existing function" );
ok( !$@, " Code handled it gracefully" );
}
### check if a method called on a class, that's not actually there
### doesn't get confused as an object call;
{ eval { $MyClass->$$ };
ok( $@, "Calling '$$' on '$MyClass' dies" );
like( $@, qr/from somewhere else/,
" Dies with an informative message" );
}
|
