Commit | Line | Data |
de8d80ef |
1 | use strict; |
2 | use warnings; |
3 | use Test::More tests => 14; |
4 | |
5 | { package Foo; sub new { bless({}, $_[0]) } } |
6 | { package Bar; our @ISA = qw(Foo); sub bar { 1 } sub does { $_[0]->isa($_[1]) } } |
7 | |
8 | my $foo = Foo->new; |
9 | my $bar = Bar->new; |
10 | my $blam = [ 42 ]; |
11 | my $undef; |
12 | |
13 | # basic does, DOES usage - |
14 | # on perls >= 5.10.0, DOES falls back to isa. |
15 | # does must always be manually provided |
16 | |
17 | if (UNIVERSAL->can('DOES')) { |
18 | ok($foo->DOES('Foo'), 'foo DOES Foo'); |
19 | ok($bar->DOES('Foo'), 'bar DOES Foo'); |
20 | } |
21 | else { |
22 | ok(!eval { $foo->DOES('Foo') }, 'DOES not available in UNIVERSAL'); |
23 | ok(!eval { $bar->DOES('Foo') }, 'DOES not available in UNIVERSAL'); |
24 | } |
25 | |
26 | ok(!eval { $foo->does('Foo') }, 'does not implemented on Foo'); |
27 | ok($bar->does('Foo'), 'bar does Foo'); |
28 | ok(!eval { $blam->DOES('Foo'); 1 }, 'blam goes blam'); |
29 | ok(!eval { $undef->DOES('Foo'); 1 }, 'undef goes poof'); |
30 | |
31 | |
32 | use Safe::Isa; |
33 | |
34 | ok($foo->$_DOES('Foo'), 'foo $_DOES Foo'); |
35 | ok($bar->$_DOES('Foo'), 'bar $_DOES Foo'); |
36 | ok(eval { $blam->$_DOES('Foo'); 1 }, 'no boom today'); |
37 | ok(eval { $undef->$_DOES('Foo'); 1 }, 'nor tomorrow either'); |
38 | |
39 | |
40 | ok($foo->$_call_if_object(DOES => 'Foo'), 'foo $_call_if_object(DOES => Foo)'); |
41 | ok($bar->$_call_if_object(DOES => 'Foo'), 'bar $_call_if_object(DOES => Foo)'); |
42 | ok(eval { $blam->$_call_if_object(DOES => 'Foo'); 1 }, 'no boom today'); |
43 | ok(eval { $undef->$_call_if_object(DOES => 'Foo'); 1 }, 'nor tomorrow either'); |
44 | |