| 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 ]; | ||||||