#!/usr/bin/perl
use
ok
'Check::ISA'
=>
qw(obj obj_does inv obj_can inv_can)
;
{
sub
new {
bless
{},
shift
}
sub
isa {
my
(
$self
,
$class
) =
@_
;
$self
->SUPER::isa(
$class
)
or
$class
eq
'Faked'
;
}
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"
);
}