Commit | Line | Data |
e6995dc6 |
1 | use strict; |
c03ede63 |
2 | use warnings; |
2e029f31 |
3 | use Test::More tests => 68; |
e6995dc6 |
4 | |
5 | { package Foo; sub new { bless({}, $_[0]) } } |
2e029f31 |
6 | { package Bar; our @ISA = qw(Foo); sub bar { wantarray ? ( 5, 6 ) : $_[1] } } |
e6995dc6 |
7 | |
8 | my $foo = Foo->new; |
9 | my $bar = Bar->new; |
10 | my $blam = [ 42 ]; |
16ec0304 |
11 | my $undef; |
e6995dc6 |
12 | |
13 | # basic isa usage - |
14 | |
15 | ok($foo->isa('Foo'), 'foo isa Foo'); |
16 | ok($bar->isa('Foo'), 'bar isa Foo'); |
17 | ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam'); |
16ec0304 |
18 | ok(!eval { $undef->isa('Foo'); 1 }, 'undef goes poof'); |
19 | |
e6995dc6 |
20 | |
21 | ok(!$foo->can('bar'), 'foo !can bar'); |
22 | ok($bar->can('bar'), 'bar can bar'); |
23 | ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam'); |
16ec0304 |
24 | ok(!eval { $undef->can('bar'); 1 }, 'undef goes poof'); |
e6995dc6 |
25 | |
26 | use Safe::Isa; |
27 | |
2e029f31 |
28 | note 'scalar context..'; |
29 | |
e6995dc6 |
30 | ok($foo->$_isa('Foo'), 'foo $_isa Foo'); |
31 | ok($bar->$_isa('Foo'), 'bar $_isa Foo'); |
b59e55e2 |
32 | ok(eval { is($blam->$_isa('Foo'), undef, 'blam isn\'t Foo'); 1 }, 'no boom today'); |
33 | ok(eval { is($undef->$_isa('Foo'), undef, 'undef isn\'t Foo either'); 1 }, 'and no boom tomorrow either'); |
e6995dc6 |
34 | |
35 | ok(!$foo->$_can('bar'), 'foo !$_can bar'); |
36 | ok($bar->$_can('bar'), 'bar $_can bar'); |
b59e55e2 |
37 | ok(eval { is($blam->$_can('bar'), undef, 'blam can\'t bar'); 1 }, 'no boom today'); |
38 | ok(eval { is($undef->$_can('bar'), undef, 'undef can\'t bar either'); 1 }, 'and no boom tomorrow either'); |
e6995dc6 |
39 | |
40 | ok($foo->$_call_if_object(isa => 'Foo'), 'foo $_call_if_object(isa => Foo)'); |
41 | ok($bar->$_call_if_object(isa => 'Foo'), 'bar $_call_if_object(isa => Foo)'); |
b5464a06 |
42 | is($bar->$_call_if_object(bar => ), undef, 'bar $_call_if_object(bar => )'); |
3f268440 |
43 | is($bar->$_call_if_object(bar => 2), 2, 'bar $_call_if_object(bar => 2)'); |
b59e55e2 |
44 | ok(eval { is($blam->$_call_if_object(isa => 'Foo'), undef, 'blam can\'t call anything'); 1 }, 'no boom today'); |
45 | ok(eval { is($undef->$_call_if_object(isa => 'Foo'), undef, 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either'); |
ff5366db |
46 | |
47 | ok($foo->$_call_if_can(isa => 'Foo'), 'foo $_call_if_can(isa => Foo)'); |
48 | ok($bar->$_call_if_can(isa => 'Foo'), 'bar $_call_if_can(isa => Foo)'); |
49 | ok(eval { is($foo->$_call_if_can(bar => ), undef, 'foo can\'t call bar'); 1 }, 'no boom today'); |
b5464a06 |
50 | is($bar->$_call_if_can(bar => ), undef, 'bar $_call_if_can(bar => )'); |
51 | is($bar->$_call_if_can(bar => 2), 2, 'bar $_call_if_can(bar => 2)'); |
ff5366db |
52 | ok(eval { is($blam->$_call_if_can(isa => 'Foo'), undef, 'blam can\'t call anything'); 1 }, 'no boom today'); |
53 | ok(eval { is($undef->$_call_if_can(isa => 'Foo'), undef, 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either'); |
2e029f31 |
54 | |
55 | |
56 | note 'list context..'; |
57 | |
58 | # isa always returns true/false |
59 | is_deeply([ $foo->$_isa('Foo') ], [ 1 ], 'foo $_isa Foo'); |
60 | is_deeply([ $bar->$_isa('Foo') ], [ 1 ], 'bar $_isa Foo'); |
61 | ok( |
62 | eval { is_deeply([ $blam->$_isa('Foo') ], [], 'blam isn\'t Foo'); 1 }, |
63 | 'no boom today', |
64 | ); |
65 | ok( |
66 | eval { is_deeply([ $undef->$_isa('Foo') ], [], 'undef isn\'t Foo either'); 1 }, |
67 | 'and no boom tomorrow either', |
68 | ); |
69 | |
70 | # can returns ref/undef if it ran, or false if not an object. |
71 | is_deeply([ $foo->$_can('bar') ], [ undef ], 'foo !$_can bar'); |
72 | is_deeply([ $bar->$_can('bar') ], [ \&Bar::bar ], 'bar $_can bar'); |
73 | ok( |
74 | eval { is_deeply([ $blam->$_can('bar') ], [], 'blam can\'t bar'); 1 }, |
75 | 'no boom today', |
76 | ); |
77 | ok( |
78 | eval { is_deeply([ $undef->$_can('bar') ], [], 'undef can\'t bar either'); 1 }, |
79 | 'and no boom tomorrow either', |
80 | ); |
81 | |
82 | # _call_if_object has the same behaviour as the method it is calling and |
83 | # propagates context. |
84 | is_deeply([ $foo->$_call_if_object(isa => 'Foo') ], [ 1 ], 'foo $_call_if_object(isa => Foo)'); |
85 | is_deeply([ $bar->$_call_if_object(isa => 'Foo') ], [ 1 ], 'bar $_call_if_object(isa => Foo)'); |
86 | is_deeply([ $bar->$_call_if_object(bar => ) ], [ 5, 6 ], 'bar $_call_if_object(bar => undef): wantarray is true'); |
87 | is_deeply([ $bar->$_call_if_object(bar => 2) ], [ 5, 6 ], 'bar $_call_if_object(bar => 2): wantarray is true'); |
88 | ok( |
89 | eval { is_deeply([ $blam->$_call_if_object(isa => 'Foo') ], [], 'blam can\'t call anything'); 1 }, |
90 | 'no boom today', |
91 | ); |
92 | ok( |
93 | eval { is_deeply([ $undef->$_call_if_object(isa => 'Foo') ], [], 'undef can\'t call anything'); 1 }, |
94 | 'and no boom tomorrow either', |
95 | ); |
96 | |
97 | # _call_if_can has the same behaviour as the method it is calling and |
98 | # propagates context. |
99 | is_deeply([ $foo->$_call_if_can(isa => 'Foo') ], [ 1 ], 'foo $_call_if_can(isa => Foo)'); |
100 | is_deeply([ $bar->$_call_if_can(isa => 'Foo') ], [ 1 ], 'bar $_call_if_can(isa => Foo)'); |
101 | ok( |
102 | eval { is_deeply([ $foo->$_call_if_can(bar => ) ], [], 'foo can\'t call bar'); 1 }, |
103 | 'no boom today', |
104 | ); |
105 | is_deeply([ $bar->$_call_if_can(bar => ) ], [ 5, 6 ], 'bar $_call_if_can(bar => ): wantarray is true'); |
106 | is_deeply([ $bar->$_call_if_can(bar => 2) ], [ 5, 6 ], 'bar $_call_if_can(bar => 2): wantarray is true'); |
107 | ok( |
108 | eval { is_deeply([ $blam->$_call_if_can(isa => 'Foo') ], [], 'blam can\'t call anything'); 1 }, |
109 | 'no boom today', |
110 | ); |
111 | ok( |
112 | eval { is_deeply([ $undef->$_call_if_can(isa => 'Foo') ], [], 'undef can\'t call anything'); 1 }, |
113 | 'and no boom tomorrow either', |
114 | ); |