1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More 'no_plan';
use ok 'Check::ISA' => qw(obj obj_does inv obj_can inv_can);
{
package Foo;
sub new { bless {}, shift }
package Bar;
use base qw(Foo);
package Gorch;
use base qw(Foo);
sub isa {
my ( $self, $class ) = @_;
$self->SUPER::isa($class)
or
$class eq 'Faked';
}
package Zot;
use base qw(Foo);
sub DOES {
my ( $self, $role ) = @_;
$self->SUPER::DOES($role)
or
$role eq 'FakedRole';
}
}
ok( !inv("Class::Does::Not::Exist"), "a random string is not a class" );
ok( !inv(undef), "undef is not a class" );
ok( !inv(0), "0 is not a class" );
ok( !inv(1), "1 is not a class" );
ok( !inv("0"), "'0' is not a class" );
ok( !inv("00"), "'00' is not a class" );
ok( !inv("1"), "'1' is not a class" );
ok( !inv(""), "'' is not a class" );
ok( !inv("blah"), "'blah' is not a class" );
ok( !inv([]), "an array ref is not a class" );
ok( !inv({}), "a hash ref is not a class" );
ok( !inv(sub {}), "a subroutine is not a class" );
ok( !obj_can(undef, "foo"), "no foo method for undef" );
ok( !obj_can("blah", "foo"), "no foo method for string" );
ok( !obj_can("blah", "isa"), "no foo method for string" );
ok( !obj_can("", "foo"), "no foo method for empty" );
ok( !obj_can({}, "foo"), "no foo method for hash refs" );
ok( !inv_can("blah", "foo"), "inv_can on random class" );
ok( !inv_can("blah", "isa"), "no foo method for string" );
ok( !inv_can("Foo", "foo"), "inv_can on Foo for nonexistent method" );
no warnings 'once';
ok( !obj(\*RANDOMGLOB), "a globref without an IO is not an object");
ok( obj(\*STDIN), "a globref with an IO is an object" );
ok( obj("STDIN"), "a filehandle name is an object" );
ok( obj_can(\*STDIN, "print"), "STDIN can print" );
ok( obj_can("STDIN", "print"), "'STDIN' can print" );
ok( inv_can(\*STDIN, "print"), "STDIN can print" );
ok( inv_can("STDIN", "print"), "'STDIN' can print" );
ok( obj(Foo->new), "Foo->new is an obj" );
ok( obj(Foo->new, "Foo"), "of class Foo" );
ok( inv(Foo->new, "Foo"), "inv works too" );
is( obj_can(Foo->new, "new"), \&Foo::new, "obj_can on obj" );
ok( !obj_can("Foo", "new"), "obj_can on non obj" );
is( inv_can(Foo->new, "new"), \&Foo::new, "inv_can on obj" );
is( inv_can("Foo", "new"), \&Foo::new, "inv_can on on obj" );
ok( !obj("Foo"), "the class is not an object" );
ok( !obj("Foo", "Foo"), "the class is not an object" );
ok( inv("Foo"), "Foo is a class" );
ok( inv("Foo", "Foo"), "class is itself" );
ok( !obj("Bar"), "Bar is not an object" );
ok( inv("Bar"), "Bar is an invocant" );
ok( inv("Bar", "Bar"), "Bar is a Bar" );
ok( inv("Bar", "Foo"), "Bar is a Foo" );
ok( inv("Gorch", "Faked"), "faked isa" );
ok( obj(Gorch->new, "Faked"), "for instance too" );
ok( inv("Gorch", "Foo"), "SUPER isa" );
ok( obj(Gorch->new, "Foo"), "for instance too" );
ok( !inv("Gorch", "Blah"), "false case" );
ok( !obj(Gorch->new, "Blah"), "for instance too" );
SKIP: {
plan skip "No DOES in this version of Perl", 6 unless UNIVERSAL->can("DOES");
ok( inv("Zot", "FakedRole"), "faked DOES" );
ok( obj_does(Zot->new, "FakedRole"), "for instance" );
ok( inv("Zot", "Foo"), "DOES also answers isa" );
ok( obj_does(Zot->new, "Foo"), "for instance" );
ok( !inv("Zot", "OiVey"), "false case" );
ok( !obj_does(Zot->new, "Blah"), "for instance too" );
}
|
