The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use lib 'lib', '../lib';

{
    package My::Common;
    sub throw_something {
        return '' if $0 =~ /_ok/;
        return 1;
    };
};

{
    package My::EvalDieObject;
    sub throw {
        my %args = @_;
        die bless {%args}, shift;
    };
};

{
    package My::Try;
    sub try ($) {
        eval { $_[0]->() };
    };
};

use Exception::Base 'Exception::My';


our %tests = (
    '01_EvalDieScalar' => sub {

        eval {
            die 'Message' if My::Common::throw_something;
        };
        if ($@ =~ /^Message/) {
            1;
        };

    },
    '02_EvalDieObject' => sub {

        eval {
             My::EvalDieObject->throw if My::Common::throw_something;
        };
        if ($@) {
            my $e = $@;
            if (ref $e and $e->isa('My::EvalDieObject')) {
                1;
            };
        };
    },
    '03_ExceptionEval' => sub {

        eval {
            Exception::My->throw(message=>'Message') if My::Common::throw_something;
        };
        if ($@) {
            my $e = Exception::Base->catch;
            if ($e->isa('Exception::My') and $e->matches('Message')) {
                1;
            };
        };

    },
    '04_Exception1Eval' => sub {

        eval {
            Exception::My->throw(message=>'Message', verbosity=>1) if My::Common::throw_something;
        };
        if ($@) {
            my $e = Exception::Base->catch;
            if ($e->isa('Exception::My') and $e->matches('Message')) {
                1;
            };
        };

    },
);

eval q{
    package My::Error;
    BEGIN {
        eval {
            require Error;
            Error->import(':try');
        };
    };
    Error->VERSION or die;

    $main::tests{'05_Error'} = sub {

        try {
            Error::Simple->throw('Message') if My::Common::throw_something;
        }
        Error->catch(with {
            my $e = $_[0];
            if ($e->text eq 'Message') {
                1;
            }
        });

    };
};

eval {
    package My::ClassThrowable;
    require Class::Throwable;
    Class::Throwable->import;

    $main::tests{'06_ClassThrowable'} = sub {

        eval {
            Class::Throwable->throw('Message') if My::Common::throw_something;
        };
        if ($@) {
            my $e = $@;
            if (ref $e and $e->isa('Class::Throwable') and $e->getMessage eq 'Message') {
                1;
            };
        };

    };
};

eval {
    package My::ExceptionClass;
    require Exception::Class;
    Exception::Class->import('MyException');

    $main::tests{'07_ExceptionClass'} = sub {

        eval {
            MyException->throw(error=>'Message') if My::Common::throw_something;
        };
        my $e;
        if ($e = Exception::Class->caught('MyException') and $e->error eq 'Message') {
            1;
        };

    };
};

eval q{
    package My::ExceptionClassTC;
    BEGIN {
        eval {
            require Exception::Class;
            Exception::Class->import('MyException');
            require Exception::Class::TryCatch;
            Exception::Class::TryCatch->import;
        };
    };
    Exception::Class::TryCatch->VERSION or die;

    $main::tests{'08_ExceptionClassTC'} = sub {

        try eval {
            MyException->throw(error=>'Message') if My::Common::throw_something;
        };
        if (catch my $e) {
            if ($e->isa('MyException') and $e->error eq 'Message') {
                1;
            }
        };

    };
};

BEGIN {
    eval q{
        package My::TryCatch;
        use TryCatch;
    };
};
eval q{
    package My::TryCatch;

    TryCatch->VERSION or die;

    $main::tests{'09_TryCatch'} = sub {

        try {
            die 'Message' if My::Common::throw_something;
        }
        catch {
            if ($@ =~ /^Message/) {
                1;
            };
        };

    };
};

BEGIN {
    eval q{
        package My::TryTiny;
        use Try::Tiny;
    };
};
eval q{
    package My::TryTiny;

    Try::Tiny->VERSION or die;

    $main::tests{'10_TryTiny'} = sub {

        try {
            die 'Message' if My::Common::throw_something;
        }
        catch {
            if ($@ =~ /^Message/) {
                1;
            };
        };

    };
};


use Benchmark ':all';

print "Benchmark for ", (My::Common::throw_something() ? "FAIL" : "OK"), "\n";
my $result = timethese($ARGV[0] || -1, { %tests });
cmpthese($result);