The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::Spec;
require Test::NoWarnings;

use syntax 'try';

# mock classes inheritance for tests
{
    package MyMock::Animal;
    sub new { bless {}, shift };

    package MyMock::Bird;
    use base 'MyMock::Animal';

    package MyMock::Raptor;
    use base 'MyMock::Bird';

    package MyMock::Eagle;
    use base 'MyMock::Raptor';
}

sub test_catch_bird {
    my ($err, $expected_result) = @_;

    my $result;
    try { die $err }
    catch (MyMock::Bird $e) { $result=1 }
    catch ($others) { $result=0 }

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    is($result, $expected_result);
}

describe "catch (MyMock::Bird ...) {}" => sub {
    it "handles exception of given class" => sub {
        test_catch_bird( MyMock::Bird->new(), 1 );
    };

    it "handles also exceptions based on given class" => sub {
        test_catch_bird( MyMock::Raptor->new(), 1 );
        test_catch_bird( MyMock::Eagle->new(), 1 );
    };

    it "ignores it's super-class(es)" => sub {
        test_catch_bird( MyMock::Animal->new(), 0 );
    };

    it "ignores other exceptions classes" => sub {
        test_catch_bird( bless({}, "MyMock::ABC"), 0 );
        test_catch_bird( bless({}, "MyMock::Bird::Two"), 0 );
    };

    it "skips also any non-object exceptions" => sub {
        test_catch_bird( {}, 0 );
        test_catch_bird( "mock-error", 0 );
        test_catch_bird( "MyMock::Bird", 0 );
    };
};

it "has no warnings" => sub {
    Test::NoWarnings::had_no_warnings();
};

runtests;