3 use Test::More tests => 14;
5 { package Foo; sub new { bless({}, $_[0]) } }
6 { package Bar; our @ISA = qw(Foo); sub bar { 1 } sub does { $_[0]->isa($_[1]) } }
13 # basic does, DOES usage -
14 # on perls >= 5.10.0, DOES falls back to isa.
15 # does must always be manually provided
17 if (UNIVERSAL->can('DOES')) {
18 ok($foo->DOES('Foo'), 'foo DOES Foo');
19 ok($bar->DOES('Foo'), 'bar DOES Foo');
22 ok(!eval { $foo->DOES('Foo') }, 'DOES not available in UNIVERSAL');
23 ok(!eval { $bar->DOES('Foo') }, 'DOES not available in UNIVERSAL');
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');
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');
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');