File: | t/04-universal.t |
Coverage: | 85.9% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | |||||||
32 | my %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 | |||||||
42 | sub 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 ]; |