view release on metacpan or  search on metacpan

t/Util.pm  view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
use strict;
use warnings;
use utf8;
use base qw/https://metacpan.org/pod/Exporter">Exporter/;
use base 'https://metacpan.org/pod/Test::Builder::Module">Test::Builder::Module';
 
my $CLASS = __PACKAGE__;
 
our @EXPORT = qw/lives_ok throws_ok lives_and/;
 
sub lives_ok(&;$) {
    my ($code, $description) = @_;
    my $tb = $CLASS->builder;
    eval { $code->() };
    $tb->ok(!$@, $description || "lives_ok");
}
 
sub throws_ok(&$;$) {
    my ($code, $regexp, $description) = @_;
    my $tb = $CLASS->builder;
    eval { $code->() };
    $tb->like($@, $regexp, $description || "throws_ok");
}
 
sub lives_and(&;$) {
    my ($code, $description) = @_;
    $CLASS->builder->subtest($description || 'lives_and', sub {
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        eval {
            $code->();
        };
        $CLASS->builder->ok(!$@, $description || 'lives_and');
    });
}