The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use warnings;
use strict;

use Test::More tests => 1 + 2*28*21;

BEGIN {
	use_ok "Params::Classify", map { ("is_$_", "check_$_") } qw(
		undef string number glob regexp
		ref blessed strictly_blessed able
	);
}

format foo =
.

my $foo = "";

@B::ISA = qw(A);

sub A::flange { }

foreach(
	undef,
	"",
	"abc",
	123,
	0,
	"0 but true",
	"1ab",
	*STDOUT,
	${qr/xyz/},
	\"",
	\\"",
	\pos($foo),
	[],
	{},
	\&is,
	do {
		my $format = *foo{FORMAT};
		defined($format) ? $format : undef;
	},
	bless({}, "main"),
	bless({}, "ARRAY"),
	bless({}, "HASH"),
	bless({}, "A"),
	bless({}, "B"),
) {
	eval { check_undef($_); };
	is $@, is_undef($_) ? "" : "argument is not undefined\n";
	eval { &check_undef($_); };
	is $@, is_undef($_) ? "" : "argument is not undefined\n";
	eval { check_string($_); };
	is $@, is_string($_) ? "" : "argument is not a string\n";
	eval { &check_string($_); };
	is $@, is_string($_) ? "" : "argument is not a string\n";
	eval { check_number($_); };
	is $@, is_number($_) ? "" : "argument is not a number\n";
	eval { &check_number($_); };
	is $@, is_number($_) ? "" : "argument is not a number\n";
	eval { check_glob($_); };
	is $@, is_glob($_) ? "" : "argument is not a typeglob\n";
	eval { &check_glob($_); };
	is $@, is_glob($_) ? "" : "argument is not a typeglob\n";
	eval { check_regexp($_); };
	is $@, is_regexp($_) ? "" : "argument is not a regexp\n";
	eval { &check_regexp($_); };
	is $@, is_regexp($_) ? "" : "argument is not a regexp\n";
	eval { check_ref($_); };
	is $@, is_ref($_) ? "" :
		"argument is not a reference to plain object\n";
	eval { &check_ref($_); };
	is $@, is_ref($_) ? "" :
		"argument is not a reference to plain object\n";
	eval { check_ref($_, "SCALAR"); };
	is $@, is_ref($_, "SCALAR") ? "" :
		"argument is not a reference to plain scalar\n";
	eval { &check_ref($_, "SCALAR"); };
	is $@, is_ref($_, "SCALAR") ? "" :
		"argument is not a reference to plain scalar\n";
	eval { check_ref($_, "ARRAY"); };
	is $@, is_ref($_, "ARRAY") ? "" :
		"argument is not a reference to plain array\n";
	eval { &check_ref($_, "ARRAY"); };
	is $@, is_ref($_, "ARRAY") ? "" :
		"argument is not a reference to plain array\n";
	eval { check_ref($_, "HASH"); };
	is $@, is_ref($_, "HASH") ? "" :
		"argument is not a reference to plain hash\n";
	eval { &check_ref($_, "HASH"); };
	is $@, is_ref($_, "HASH") ? "" :
		"argument is not a reference to plain hash\n";
	eval { check_ref($_, "CODE"); };
	is $@, is_ref($_, "CODE") ? "" :
		"argument is not a reference to plain code\n";
	eval { &check_ref($_, "CODE"); };
	is $@, is_ref($_, "CODE") ? "" :
		"argument is not a reference to plain code\n";
	eval { check_ref($_, "FORMAT"); };
	is $@, is_ref($_, "FORMAT") ? "" :
		"argument is not a reference to plain format\n";
	eval { &check_ref($_, "FORMAT"); };
	is $@, is_ref($_, "FORMAT") ? "" :
		"argument is not a reference to plain format\n";
	eval { check_ref($_, "IO"); };
	is $@, is_ref($_, "IO") ? "" :
		"argument is not a reference to plain io\n";
	eval { &check_ref($_, "IO"); };
	is $@, is_ref($_, "IO") ? "" :
		"argument is not a reference to plain io\n";
	foreach my $type (qw(SCALAR ARRAY HASH CODE FORMAT IO)) {
		eval { check_ref($_, $type); };
		is $@, is_ref($_, $type) ? "" :
			"argument is not a reference to plain @{[lc($type)]}\n";
		eval { &check_ref($_, $type); };
		is $@, is_ref($_, $type) ? "" :
			"argument is not a reference to plain @{[lc($type)]}\n";
	}
	eval { check_blessed($_); };
	is $@, is_blessed($_) ? "" :
		"argument is not a reference to blessed object\n";
	eval { &check_blessed($_); };
	is $@, is_blessed($_) ? "" :
		"argument is not a reference to blessed object\n";
	eval { check_blessed($_, "A"); };
	is $@, is_blessed($_, "A") ? "" :
		"argument is not a reference to blessed A\n";
	eval { &check_blessed($_, "A"); };
	is $@, is_blessed($_, "A") ? "" :
		"argument is not a reference to blessed A\n";
	eval { check_blessed($_, "B"); };
	is $@, is_blessed($_, "B") ? "" :
		"argument is not a reference to blessed B\n";
	eval { &check_blessed($_, "B"); };
	is $@, is_blessed($_, "B") ? "" :
		"argument is not a reference to blessed B\n";
	eval { check_strictly_blessed($_); };
	is $@, is_blessed($_) ? "" :
		"argument is not a reference to blessed object\n";
	eval { &check_strictly_blessed($_); };
	is $@, is_blessed($_) ? "" :
		"argument is not a reference to blessed object\n";
	eval { check_strictly_blessed($_, "A"); };
	is $@, is_strictly_blessed($_, "A") ? "" :
		"argument is not a reference to strictly blessed A\n";
	eval { &check_strictly_blessed($_, "A"); };
	is $@, is_strictly_blessed($_, "A") ? "" :
		"argument is not a reference to strictly blessed A\n";
	eval { check_strictly_blessed($_, "B"); };
	is $@, is_strictly_blessed($_, "B") ? "" :
		"argument is not a reference to strictly blessed B\n";
	eval { &check_strictly_blessed($_, "B"); };
	is $@, is_strictly_blessed($_, "B") ? "" :
		"argument is not a reference to strictly blessed B\n";
	eval { check_able($_); };
	is $@, is_able($_) ? "" :
		"argument is not a reference to blessed object\n";
	eval { &check_able($_); };
	is $@, is_able($_) ? "" :
		"argument is not a reference to blessed object\n";
	eval { check_able($_, []); };
	is $@, is_able($_, []) ? "" :
		"argument is not able to perform at all\n";
	eval { &check_able($_, []); };
	is $@, is_able($_, []) ? "" :
		"argument is not able to perform at all\n";
	eval { check_able($_, "flange"); };
	is $@, is_able($_, "flange") ? "" :
		"argument is not able to perform method \"flange\"\n";
	eval { &check_able($_, "flange"); };
	is $@, is_able($_, "flange") ? "" :
		"argument is not able to perform method \"flange\"\n";
	eval { check_able($_, ["flange","can"]); };
	is $@, is_able($_, ["flange","can"]) ? "" :
		"argument is not able to perform method \"flange\"\n";
	eval { &check_able($_, ["flange","can"]); };
	is $@, is_able($_, ["flange","can"]) ? "" :
		"argument is not able to perform method \"flange\"\n";
}

1;