3 use Test::More tests => 20;
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');
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');
45 if (UNIVERSAL->can('DOES')) {
46 ok($foo->$_call_if_object(DOES => 'Foo'), 'foo $_call_if_object(DOES => Foo)');
47 ok($bar->$_call_if_object(DOES => 'Foo'), 'bar $_call_if_object(DOES => Foo)');
50 ok(!eval { $foo->$_call_if_object(DOES => 'Foo'); 1 },
51 'foo $_call_if_object(DOES => Foo) fails without UNIVERSAL::DOES');
52 ok(!eval { $bar->$_call_if_object(DOES => 'Foo'); 1 },
53 'bar $_call_if_object(DOES => Foo) fails without UNIVERSAL::DOES');
56 ok(eval { $blam->$_call_if_object(DOES => 'Foo'); 1 }, 'no boom today');
57 ok(eval { $undef->$_call_if_object(DOES => 'Foo'); 1 }, 'nor tomorrow either');
59 ok(!eval { $foo->$_call_if_object(does => 'Foo'); 1 }, 'no special DOES handling built into _call_if_object');
60 ok(!eval { $foo->$_call_if_object(Does => 'Foo'); 1 }, 'and no handling for wrong case');