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