File Coverage

blib/lib/Test2/Tools/Exception.pm

Criterion	Covered	Total	%
statement	45	48	93.7
branch	11	12	91.6
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	67	71	94.3

package Test2::Tools::Exception;
use strict;
use warnings;

our $VERSION = '0.000153';

use Carp qw/carp/;
use Test2::API qw/context/;

our @EXPORT = qw/dies lives try_ok/;
use base 'Exporter';

sub dies(&) {
    my $code = shift;

    defined wantarray or carp "Useless use of dies() in void context";

    local ($@, $!, $?);
    my $ok = eval { $code->(); 1 };
    my $err = $@;

    return undef if $ok;

    unless ($err) {
        my $ctx = context();
        $ctx->alert("Got exception as expected, but exception is falsy (undef, '', or 0)...");
        $ctx->release;
    }

    return $err;
}

sub lives(&) {
    my $code = shift;

    defined wantarray or carp "Useless use of lives() in void context";

    my $err;
    {
        local ($@, $!, $?);
        eval { $code->(); 1 } and return 1;
        $err = $@;
    }

    # If the eval failed we want to set $@ to the error.
    $@ = $err;
    return 0;
}

sub try_ok(&;$) {
    my ($code, $name) = @_;

    my $ok = &lives($code);
    my $err = $@;

    # Context should be obtained AFTER code is run so that events inside the
    # codeblock report inside the codeblock itself. This will also preserve $@
    # as thrown inside the codeblock.
    my $ctx = context();
    chomp(my $diag = "Exception: $err");
    $ctx->ok($ok, $name, [$diag]);
    $ctx->release;

    $@ = $err unless $ok;
    return $ok;
}

1;

__END__