<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Test2::Tools::Exception;
use strict;
use warnings;

our $VERSION = '0.000162';

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

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

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

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

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

    return undef if $ok;

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

    return $err;
}

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

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

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

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

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

    my $ok = &amp;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-&gt;ok($ok, $name, [$diag]);
    $ctx-&gt;release;

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

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Tools::Exception - Test2 based tools for checking exceptions

=head1 DESCRIPTION

This is the L&lt;Test2&gt; implementation of code used to test exceptions. This is
similar to L&lt;Test::Fatal&gt;, but it intentionally does much less.

=head1 SYNOPSIS

    use Test2::Tools::Exception qw/dies lives/;

    like(
        dies { die 'xxx' },
        qr/xxx/,
        "Got exception"
    );

    ok(lives { ... }, "did not die") or note($@);

=head1 EXPORTS

All subs are exported by default.

=over 4

=item $e = dies { ... }

This will trap any exception the codeblock throws. If no exception is thrown
the sub will return undef. If an exception is thrown it will be returned. This
function preserves C&lt;$@&gt;, it will not be altered from its value before the sub
is called.

=item $bool = lives { ... }

This will trap any exception thrown in the codeblock. It will return true when
there is no exception, and false when there is. C&lt;$@&gt; is preserved from before
the sub is called when there is no exception. When an exception is trapped
C&lt;$@&gt; will have the exception so that you can look at it.

=item $bool = try_ok { ... }

=item $bool = try_ok { ... } "Test Description"

This will run the code block trapping any exception. If there is no exception a
passing event will be issued. If the test fails a failing event will be issued,
and the exception will be reported as diagnostics.

B&lt;Note:&gt; This function does not preserve C&lt;$@&gt; on failure, it will be set to
the exception the codeblock throws, this is by design so that you can obtain
the exception if desired.

=back

=head1 DIFFERENCES FROM TEST::FATAL

L&lt;Test::Fatal&gt; sets C&lt;$Test::Builder::Level&gt; such that failing tests inside the
exception block will report to the line where C&lt;exception()&gt; is called. I
disagree with this, and think the actual line of the failing test is
more important. Ultimately, though L&lt;Test::Fatal&gt; cannot be changed, people
probably already depend on that behavior.

=head1 SOURCE

The source code repository for Test2-Suite can be found at
F&lt;https://github.com/Test-More/Test2-Suite/&gt;.

=head1 MAINTAINERS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=back

=head1 AUTHORS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F&lt;http://dev.perl.org/licenses/&gt;

=cut
</pre></body></html>