bench.pl

#!/usr/bin/perl

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

BEGIN {
    package My::Common;
    *throw_something = $0 =~ /_ok/ ? sub () { 0 } : sub () { 1 };
};

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



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 ($@) {
            if (ref $@ && $@->isa('My::EvalDieObject')) {
              my $e = $@;
              1;
            }
        }
    },
);


eval { 
  eval q{use Exception::Base 'Exception::My'};
$tests{ '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;
            };
        };

    };
$tests{ '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{
    die 1;
    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;
            }
        };

    };
};


{
    package My::TryCatch;
    use TryCatch;

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

        try {
            die 'Message this message' if My::Common::throw_something;
        }
        catch ($e) {
            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);