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

use Test::More;

package Foo;

sub foo {
    my $class = shift;

    TestException->throw(@_) unless $class eq 'Foo';

    Bar->bar(@_);
}

package Bar;

sub bar {
    shift;
    Baz->baz(@_);
}

package Baz;

use vars qw(@ISA);
@ISA = qw(Foo);

sub baz {
    shift->foo(@_);
}

package main;

use strict;

use Exception::Class qw(TestException);

sub check_trace {
    my ( $trace, $unwanted_pkg, $unwanted_class ) = @_;

    my ($bad_frame);
    while ( my $frame = $trace->next_frame ) {
        if (
            ( grep { $frame->package eq $_ } @$unwanted_pkg )
            || ( grep { UNIVERSAL::isa( $frame->package, $_ ) }
                @$unwanted_class )
            ) {
            $bad_frame = $frame;
            last;
        }
    }

    ok( !$bad_frame, "Check for unwanted frames" );
    diag("Unwanted frame found: $bad_frame")
        if $bad_frame;
}

eval { Foo->foo() };
my $e = $@;

check_trace( $e->trace, [], [] );

eval { Foo->foo( ignore_package => ['Baz'] ) };
$e = $@;

check_trace( $e->trace, ['Baz'], [] );

eval { Foo->foo( ignore_class => ['Foo'] ) };
$e = $@;

check_trace( $e->trace, [], ['Foo'] );

eval { Foo->foo( ignore_package => [ 'Foo', 'Baz' ] ) };
$e = $@;

check_trace( $e->trace, [ 'Foo', 'Baz' ], [] );

done_testing();