File Coverage

inc/Test/Fatal.pm
Criterion Covered Total %
statement 27 40 67.5
branch 2 10 20.0
condition 2 6 33.3
subroutine 9 12 75.0
pod 4 4 100.0
total 44 72 61.1


line stmt bran cond sub pod time code
1 215     215   11671482 #line 1
  215         2174  
  215         6468  
2 215     215   1277 use strict;
  215         507  
  215         10944  
3             use warnings;
4             package Test::Fatal;
5             {
6             $Test::Fatal::VERSION = '0.010';
7             }
8             # ABSTRACT: incredibly simple helpers for testing code with exceptions
9              
10 215     215   1460  
  215         494  
  215         6524  
11 215     215   104132 use Carp ();
  215         4964  
  215         13273  
12             use Try::Tiny 0.07;
13 215     215   1611  
  215         480  
  215         117197  
14             use base 'Exporter';
15              
16             our @EXPORT = qw(exception);
17             our @EXPORT_OK = qw(exception success dies_ok lives_ok);
18              
19              
20 3682     3682 1 1335092 sub exception (&) {
21             my $code = shift;
22              
23 3682     3682   9356 return try {
24 1006         146110 $code->();
25             return undef;
26 2676 50   2676   25424 } catch {
27             return $_ if $_;
28 0 0       0  
29 0         0 my $problem = defined $_ ? 'false' : 'undef';
30 3682         18663 Carp::confess("$problem exception caught by Test::Fatal::exception");
31             };
32             }
33              
34              
35 0     0 1 0 sub success (&;@) {
36             my $code = shift;
37 0 0   0   0 return finally( sub {
38 0         0 return if @_; # <-- only run on success
39 0         0 $code->();
40             }, @_ );
41             }
42              
43              
44             my $Tester;
45              
46             # Signature should match that of Test::Exception
47 5     5 1 625 sub dies_ok (&;$) {
48 5         10 my $code = shift;
49             my $name = shift;
50 5         27  
51 5   66     22 require Test::Builder;
52             $Tester ||= Test::Builder->new;
53 5         31  
54 5 50       1191 my $ok = $Tester->ok( exception( \&$code ), $name );
55 5         21 $ok or $Tester->diag( "expected an exception but none was raised" );
56             return $ok;
57             }
58              
59 0     0 1   sub lives_ok (&;$) {
60 0           my $code = shift;
61             my $name = shift;
62 0            
63 0   0       require Test::Builder;
64             $Tester ||= Test::Builder->new;
65 0            
66 0 0         my $ok = $Tester->ok( !exception( \&$code ), $name );
67 0           $ok or $Tester->diag( "expected return but an exception was raised" );
68             return $ok;
69             }
70              
71             1;
72              
73             __END__
74             #line 212
75