File Coverage

blib/lib/Test/Mini/Logger/TAP.pm
Criterion Covered Total %
statement 46 46 100.0
branch 2 2 100.0
condition n/a
subroutine 15 15 100.0
pod 8 11 72.7
total 71 74 95.9


line stmt bran cond sub pod time code
1             # Default Test::Mini Output Logger.
2             package Test::Mini::Logger::TAP;
3              
4 3     3   15450 use 5.006;
  3         10  
5 3     3   13 use strict;
  3         6  
  3         53  
6 3     3   12 use warnings;
  3         5  
  3         76  
7              
8 3     3   14 use parent 'Test::Mini::Logger';
  3         5  
  3         20  
9              
10             sub new {
11 16     16 1 494 my ($class, %args) = @_;
12 16         71 return $class->SUPER::new(test_counter => 0, %args);
13             }
14              
15             sub test_counter {
16 68     68 0 84 my ($self) = @_;
17 68         384 return $self->{test_counter};
18             }
19              
20             sub inc_counter {
21 67     67 0 78 my ($self) = @_;
22 67         157 $self->{test_counter}++;
23             }
24              
25             sub diag {
26 13     13 0 134 my ($self, @msgs) = @_;
27 13         26 my $msg = join "\n", @msgs;
28 13         49 $msg =~ s/^/# /mg;
29 13         48 $self->say($msg);
30             }
31              
32             sub begin_test_case {
33 4     4 1 17 my ($self, $tc, @tests) = @_;
34 4         16 $self->diag("Test Case: $tc");
35             }
36              
37             sub begin_test {
38 67     67 1 281 my ($self) = @_;
39 67         134 $self->inc_counter();
40             }
41              
42             sub pass {
43 52     52 1 90 my ($self, undef, $test) = @_;
44 52         79 $self->say("ok @{[$self->test_counter]} - $test");
  52         123  
45             }
46              
47             sub fail {
48 4     4 1 16 my ($self, undef, $test, $msg) = @_;
49 4         8 $self->say("not ok @{[$self->test_counter]} - $test");
  4         7  
50 4         46 $self->diag($msg);
51             }
52              
53             sub error {
54 4     4 1 17 my ($self, undef, $test, $msg) = @_;
55 4         6 $self->say("not ok @{[$self->test_counter]} - $test");
  4         8  
56 4         45 $self->diag($msg);
57             }
58              
59             sub skip {
60 4     4 1 15 my ($self, undef, $test, $msg) = @_;
61 4         5 $self->print("ok @{[$self->test_counter]} - $test # SKIP");
  4         8  
62              
63 4 100       46 if ($msg =~ /\n/) {
64 1         4 $self->say();
65 1         11 $self->diag($msg);
66             } else {
67 3         10 $self->say(": $msg");
68             }
69             }
70              
71             sub finish_test_suite {
72 4     4 1 9 my ($self) = @_;
73 4         20 $self->say("1..@{[$self->test_counter]}");
  4         11  
74             }
75              
76             1;