#!/usr/bin/perl use warnings; use strict; use Test::More; use Declare::Constraints::Simple only => qw(IsA IsClass HasMethods IsObject); { package TestA; sub foo { } sub bar { } package TestB; use base 'TestA'; sub foo { } } my $testA = bless {} => 'TestA'; my $testB = bless {} => 'TestB'; my @test_sets = ( [IsA(qw(TestNone TestA)), $testA, 1, 'IsA multiple true'], [IsA('TestB'), $testA, 0, 'IsA false'], [IsA('TestA'), undef, 0, 'IsA undef'], [IsA(), $testA, 0, 'IsA empty'], [IsA('TestA'), 'TestB', 1, 'IsA class true'], [IsA('TestA'), 'Foo', 0, 'IsA class unknown'], [IsA('TestB'), 'TestA', 0, 'IsA class false'], [IsClass, 'Foo', 0, 'IsClass false'], [IsClass, undef, 0, 'IsClass undef'], [IsClass, 'TestA', 1, 'IsClass true'], [IsObject, undef, 0, 'IsObject undef'], [IsObject, "foo", 0, 'IsObject string'], [IsObject, {}, 0, 'IsObject hash ref'], [IsObject, $testA, 1, 'IsObject true'], [HasMethods(qw(foo)), $testA, 1, 'HasMethods true'], [HasMethods(qw(foo bar)), $testA, 1, 'HasMethods multiple true'], [HasMethods(qw(foo baz)), $testA, 0, 'HasMethods half false'], [HasMethods(qw(baz)), $testA, 0, 'HasMethods all false'], [HasMethods(qw(bar)), $testB, 1, 'HasMethods inherited true'], [HasMethods(), $testB, 1, 'HasMethods no list true'], [HasMethods(), "foo", 0, 'HasMethods no list no class'], [HasMethods(qw(foo)), undef, 0, 'HasMethods undef'], ); plan tests => scalar(@test_sets); for (@test_sets) { my ($check, $value, $expect, $title) = @$_; my $result = $check->($value); is(($result ? 1 : 0), $expect, $title); }