Commit | Line | Data |
de8d80ef |
1 | use strict; |
2 | use warnings; |
9d3d6b49 |
3 | use Test::More tests => 20; |
de8d80ef |
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 | |
9d3d6b49 |
39 | # does should not fall back to isa |
40 | ok(!$foo->$_does('Foo'), 'foo !$_does Foo'); |
41 | ok($bar->$_does('Foo'), 'bar $_does Foo'); |
42 | ok(eval { $blam->$_does('Foo'); 1 }, 'no boom today'); |
43 | ok(eval { $undef->$_does('Foo'); 1 }, 'nor tomorrow either'); |
de8d80ef |
44 | |
45 | ok($foo->$_call_if_object(DOES => 'Foo'), 'foo $_call_if_object(DOES => Foo)'); |
46 | ok($bar->$_call_if_object(DOES => 'Foo'), 'bar $_call_if_object(DOES => Foo)'); |
47 | ok(eval { $blam->$_call_if_object(DOES => 'Foo'); 1 }, 'no boom today'); |
48 | ok(eval { $undef->$_call_if_object(DOES => 'Foo'); 1 }, 'nor tomorrow either'); |
49 | |
9d3d6b49 |
50 | ok(!eval { $foo->$_call_if_object(does => 'Foo'); 1 }, 'no special DOES handling built into _call_if_object'); |
51 | ok(!eval { $foo->$_call_if_object(Does => 'Foo'); 1 }, 'and no handling for wrong case'); |