File Coverage

File:t/04-universal.t
Coverage:85.9%

linestmtbrancondsubpodtimecode
1#!perl
2
3
1
1
1
64133
4
83
use strict;
4
1
1
1
5
1
42
use warnings;
5
6
1
1
1
636
70232
10
use Test::More tests => 13;
7
8
1
1
1
1614
3
10918
use Util::Underscore;
9
10{
11
12
1
187471
    package Local::Parent;
13
2
22
    sub meth { @_ == 3 }
14
0
0
    sub marker { }
15
16    package Local::Child;
17
1
16
    push @Local::Child::ISA, 'Local::Parent';
18
19    package Local::Mocker;
20
1
14
    sub meth { @_ == 3 }
21
22    sub DOES {
23
1
14
        my ($self, $what) = @_;
24
1
5
        return 1 if $what eq 'Local::Parent';
25
0
0
        goto &SUPER::DOES;
26    }
27
28    package Local::Unrelated;
29
1
13
    sub meth { @_ == 3 }
30}
31
32my %functions = (
33
13
51
    isa => sub { _::isa $_, 'Local::Parent' },
34
13
48
    does => sub { _::does $_, 'Local::Parent' },
35
13
45
    can => sub { _::can $_, 'marker', },
36
13
48
    safecall => sub { _::safecall $_, meth => 1, 2 },
37
0
0
    class_isa => sub { _::class_isa $_, 'Local::Parent' },
38
0
0
    class_does => sub { _::class_does $_, 'Local::Parent' },
39
0
0
    is_instance => sub { _::is_instance $_, 'Local::Parent' },
40
1
50
);
41
42sub value_matrix_ok {
43
3
13
    my ($names, $objects, %results) = @_;
44
3
13
    for my $i (0 .. $#$names) {
45        subtest $names->[$i] => sub {
46
13
10276
            plan tests => scalar keys %results;
47
13
4454
            while (my ($fn, $expected) = each %results) {
48
52
46920
                local $_ = $objects->[$i];
49
52
155
                my ($result) = $functions{$fn}->();
50
52
508
                $result = $result ? 1 : 0;
51
52
188
                is $result, $expected->[$i], $fn;
52            }
53
13
14049
        };
54    }
55}
56
57
1
4
my $pi = bless [] => 'Local::Parent';
58
1
4
my $ci = bless [] => 'Local::Child';
59
1
3
my $mi = bless [] => 'Local::Mocker';
60
1
3
my $ui = bless [] => 'Local::Unrelated';
61
1
2
my $pp = 'Local::Parent';
62
1
2
my $cp = 'Local::Child';
63
1
2
my $mp = 'Local::Mocker';
64
1
2
my $up = 'Local::Unrelated';
65
66
1
10
value_matrix_ok
67    [qw[ iparent ichild imocker iunrelated ]],
68    [ $pi, $ci, $mi, $ui ],
69    isa => [ 1, 1, 0, 0 ],
70    does => [ 1, 1, 1, 0 ],
71    can => [ 1, 1, 0, 0 ],
72    safecall => [ 1, 1, 1, 1 ],
73    safecall => [ 1, 1, 1, 1 ];
74
1
1338
value_matrix_ok
75    [qw[ pparent pchild pmocker punrelated ]],
76    [ $pp, $cp, $mp, $up ],
77    isa => [ 0, 0, 0, 0 ],
78    does => [ 0, 0, 0, 0 ],
79    can => [ 0, 0, 0, 0 ],
80    safecall => [ 0, 0, 0, 0 ];
81
1
1331
value_matrix_ok
82    [qw[ string number undef hash array ]],
83    [ '', 42, undef, {}, [] ],
84    isa => [ 0, 0, 0, 0, 0 ],
85    does => [ 0, 0, 0, 0, 0 ],
86    can => [ 0, 0, 0, 0, 0 ],
87    safecall => [ 0, 0, 0, 0, 0 ];