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*(4 + 2*4 + 5)*8;

@B::ISA = qw(A);

sub A::flange { }

BEGIN {
	use_ok "Params::Classify", qw(
		is_blessed blessed_class is_strictly_blessed is_able
	);
}

my @class_names = qw(UNIVERSAL qwerty A B);
my @method_names = qw(qwerty can isa print flange);

sub test_blessed($$@) {
	my($scalar, $class, $isb, @expect) = @_;
	is(blessed_class($scalar), $class);
	is(&blessed_class($scalar), $class);
	is(!!is_blessed($scalar), !!$isb);
	is(!!&is_blessed($scalar), !!$isb);
	is(!!is_strictly_blessed($scalar), !!$isb);
	is(!!&is_strictly_blessed($scalar), !!$isb);
	is(!!is_able($scalar), !!$isb);
	is(!!&is_able($scalar), !!$isb);
	foreach my $cn (@class_names) {
		my $state = shift(@expect);
		is(!!is_blessed($scalar, $cn), !!$state);
		is(!!&is_blessed($scalar, $cn), !!$state);
		is(!!is_strictly_blessed($scalar, $cn), $state eq 2);
		is(!!&is_strictly_blessed($scalar, $cn), $state eq 2);
	}
	foreach my $mn (@method_names) {
		my $expect = !!shift(@expect);
		is(!!is_able($scalar, $mn), $expect);
		is(!!&is_able($scalar, $mn), $expect);
	}
}

test_blessed(undef,             undef,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
test_blessed("foo",             undef,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
test_blessed(123,               undef,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
test_blessed(*STDOUT,           undef,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
test_blessed({},                undef,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0);

test_blessed(bless({}, "main"), "main", 1, 1, 0, 0, 0, 0, 1, 1, 0, 0);
test_blessed(bless({}, "A"),    "A",    1, 1, 0, 2, 0, 0, 1, 1, 0, 1);
test_blessed(bless({}, "B"),    "B",    1, 1, 0, 1, 2, 0, 1, 1, 0, 1);

1;