1use Test2::Bundle::Extended -target => 'Test2::Tools::Class';
2
3{
4    package Temp;
5    use Test2::Tools::Class;
6
7    main::imported_ok(qw/can_ok isa_ok DOES_ok/);
8}
9
10{
11    package X;
12
13    sub can {
14        my $thing = pop;
15        return 1 if $thing =~ m/x/;
16        return 1 if $thing eq 'DOES';
17    }
18
19    sub isa {
20        my $thing = pop;
21        return 1 if $thing =~ m/x/;
22    }
23
24    sub DOES {
25        my $thing = pop;
26        return 1 if $thing =~ m/x/;
27    }
28}
29
30{
31    package XYZ;
32    use Carp qw/croak/;
33    sub isa { croak 'oops' };
34    sub can { croak 'oops' };
35    sub DOES { croak 'oops' };
36}
37
38{
39    package My::String;
40    use overload '""' => sub { "xxx\nyyy" };
41
42    sub DOES { 0 }
43}
44
45like(
46    intercept {
47        my $str = bless {}, 'My::String';
48
49        isa_ok('X', qw/axe box fox/);
50        can_ok('X', qw/axe box fox/);
51        DOES_ok('X', qw/axe box fox/);
52        isa_ok($str, 'My::String');
53
54        isa_ok('X',  qw/foo bar axe box/);
55        can_ok('X',  qw/foo bar axe box/);
56        DOES_ok('X', qw/foo bar axe box/);
57
58        isa_ok($str, 'X');
59        can_ok($str, 'X');
60        DOES_ok($str, 'X');
61
62        isa_ok(undef, 'X');
63        isa_ok('', 'X');
64        isa_ok({}, 'X');
65
66        isa_ok('X',  [qw/axe box fox/], 'alt name');
67        can_ok('X',  [qw/axe box fox/], 'alt name');
68        DOES_ok('X', [qw/axe box fox/], 'alt name');
69
70        isa_ok('X',  [qw/foo bar axe box/], 'alt name');
71        can_ok('X',  [qw/foo bar axe box/], 'alt name');
72        DOES_ok('X', [qw/foo bar axe box/], 'alt name');
73    },
74    array {
75        event Ok => { pass => 1, name => 'X->isa(...)' };
76        event Ok => { pass => 1, name => 'X->can(...)' };
77        event Ok => { pass => 1, name => 'X->DOES(...)' };
78        event Ok => { pass => 1, name => qr/My::String=.*->isa\('My::String'\)/ };
79
80        fail_events Ok => sub { call pass => 0 };
81        event Diag => {message => "Failed: X->isa('foo')"};
82        event Diag => {message => "Failed: X->isa('bar')"};
83        fail_events Ok => sub { call pass => 0 };
84        event Diag => { message => "Failed: X->can('foo')" };
85        event Diag => { message => "Failed: X->can('bar')" };
86        fail_events Ok => sub { call pass => 0 };
87        event Diag => { message => "Failed: X->DOES('foo')" };
88        event Diag => { message => "Failed: X->DOES('bar')" };
89
90        fail_events Ok => sub { call pass => 0 };
91        event Diag => { message => qr/Failed: My::String=HASH->isa\('X'\)/ };
92        fail_events Ok => sub { call pass => 0 };
93        event Diag => { message => qr/Failed: My::String=HASH->can\('X'\)/ };
94        fail_events Ok => sub { call pass => 0 };
95        event Diag => { message => qr/Failed: My::String=HASH->DOES\('X'\)/ };
96
97        fail_events Ok => sub { call pass => 0 };
98        event Diag => { message => qr/<undef> is neither a blessed reference or a package name/ };
99        fail_events Ok => sub { call pass => 0 };
100        event Diag => { message => qr/'' is neither a blessed reference or a package name/ };
101        fail_events Ok => sub { call pass => 0 };
102        event Diag => { message => qr/HASH is neither a blessed reference or a package name/ };
103
104        event Ok => { pass => 1, name => 'alt name' };
105        event Ok => { pass => 1, name => 'alt name' };
106        event Ok => { pass => 1, name => 'alt name' };
107
108        fail_events Ok => sub { call pass => 0; call name => 'alt name' };
109        event Diag => {message => "Failed: X->isa('foo')"};
110        event Diag => {message => "Failed: X->isa('bar')"};
111        fail_events Ok => sub { call pass => 0; call name => 'alt name' };
112        event Diag => {message => "Failed: X->can('foo')"};
113        event Diag => {message => "Failed: X->can('bar')"};
114        fail_events Ok => sub { call pass => 0; call name => 'alt name' };
115        event Diag => {message => "Failed: X->DOES('foo')"};
116        event Diag => {message => "Failed: X->DOES('bar')"};
117
118        end;
119    },
120    "'can/isa/DOES_ok' events"
121);
122
123my $override = UNIVERSAL->can('DOES') ? 1 : 0;
124note "Will override UNIVERSAL::can to hide 'DOES'" if $override;
125
126my $events = intercept {
127    my $can = \&UNIVERSAL::can;
128
129    # If the platform does support 'DOES' lets pretend it doesn't.
130    no warnings 'redefine';
131    local *UNIVERSAL::can = sub {
132        my ($thing, $sub) = @_;
133        return undef if $sub eq 'DOES';
134        $thing->$can($sub);
135    } if $override;
136
137    DOES_ok('A::Fake::Package', 'xxx');
138};
139
140like(
141    $events,
142    array {
143        event Skip => {
144            pass   => 1,
145            name   => "A::Fake::Package->DOES('xxx')",
146            reason => "'DOES' is not supported on this platform",
147        };
148    },
149    "Test us skipped when platform does not support 'DOES'"
150);
151
152done_testing;
153