File Coverage

blib/lib/TAP/Formatter/Session.pm
Criterion Covered Total %
statement 58 77 75.3
branch 17 34 50.0
condition 2 10 20.0
subroutine 14 17 82.3
pod 5 5 100.0
total 96 143 67.1


line stmt bran cond sub pod time code
1             package TAP::Formatter::Session;
2              
3 16     27   77 use strict;
  16         20  
  16         386  
4 16     27   55 use warnings;
  16         19  
  16         372  
5              
6 16     16   55 use base 'TAP::Base';
  16         18  
  16         1661  
7              
8             my @ACCESSOR;
9              
10             BEGIN {
11              
12 16     16   54 @ACCESSOR = qw( name formatter parser show_count );
13              
14 16         40 for my $method (@ACCESSOR) {
15 16     16   64 no strict 'refs';
  16         18  
  16         877  
16 64     1740   12607 *$method = sub { shift->{$method} };
  1740     11   4191  
17             }
18             }
19              
20             =head1 NAME
21              
22             TAP::Formatter::Session - Abstract base class for harness output delegate
23              
24             =head1 VERSION
25              
26             Version 3.38
27              
28             =cut
29              
30             our $VERSION = '3.38';
31              
32             =head1 METHODS
33              
34             =head2 Class Methods
35              
36             =head3 C
37              
38             my %args = (
39             formatter => $self,
40             )
41             my $harness = TAP::Formatter::Console::Session->new( \%args );
42              
43             The constructor returns a new C object.
44              
45             =over 4
46              
47             =item * C
48              
49             =item * C
50              
51             =item * C
52              
53             =item * C
54              
55             =back
56              
57             =cut
58              
59             sub _initialize {
60 107     107   190 my ( $self, $arg_for ) = @_;
61 107   50     307 $arg_for ||= {};
62              
63 107         712 $self->SUPER::_initialize($arg_for);
64 107         523 my %arg_for = %$arg_for; # force a shallow copy
65              
66 107         345 for my $name (@ACCESSOR) {
67 428         761 $self->{$name} = delete $arg_for{$name};
68             }
69              
70 107 50       287 if ( !defined $self->show_count ) {
71 107         164 $self->{show_count} = 1; # defaults to true
72             }
73 107 50       179 if ( $self->show_count ) { # but may be a damned lie!
74 107         405 $self->{show_count} = $self->_should_show_count;
75             }
76              
77 107 50       414 if ( my @props = sort keys %arg_for ) {
78 0         0 $self->_croak(
79             "Unknown arguments to " . __PACKAGE__ . "::new (@props)" );
80             }
81              
82 107         324 return $self;
83             }
84              
85             =head3 C
86              
87             Output test preamble
88              
89             =head3 C
90              
91             Called by the harness for each line of TAP it receives.
92              
93             =head3 C
94              
95             Called to close a test session.
96              
97             =head3 C
98              
99             Called by C to clear the line showing test progress, or the parallel
100             test ruler, prior to printing the final test result.
101              
102             =head3 C
103              
104             Return a formatted string about the elapsed (wall-clock) time
105             and about the consumed CPU time.
106              
107             =cut
108              
109       93 1   sub header { }
110              
111       0 1   sub result { }
112              
113       0 1   sub close_test { }
114              
115       0 1   sub clear_for_close { }
116              
117             sub _should_show_count {
118 107     107   124 my $self = shift;
119             return
120             !$self->formatter->verbose
121             && -t $self->formatter->stdout
122 107   33     257 && !$ENV{HARNESS_NOTTY};
123             }
124              
125             sub _format_for_output {
126 53     53   54 my ( $self, $result ) = @_;
127 53 50       71 return $self->formatter->normalize ? $result->as_string : $result->raw;
128             }
129              
130             sub _output_test_failure {
131 37     37   72 my ( $self, $parser ) = @_;
132 37         93 my $formatter = $self->formatter;
133 37 50       101 return if $formatter->really_quiet;
134              
135 37         99 my $tests_run = $parser->tests_run;
136 37         90 my $tests_planned = $parser->tests_planned;
137              
138 37 100       134 my $total
139             = defined $tests_planned
140             ? $tests_planned
141             : $tests_run;
142              
143 37         97 my $passed = $parser->passed;
144              
145             # The total number of fails includes any tests that were planned but
146             # didn't run
147 37         85 my $failed = $parser->failed + $total - $tests_run;
148 37         85 my $exit = $parser->exit;
149              
150 37 100       77 if ( my $exit = $parser->exit ) {
151 10         25 my $wstat = $parser->wait;
152 10         55 my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat );
153 10         54 $formatter->_failure_output("Dubious, test returned $status\n");
154             }
155              
156 37 100       102 if ( $failed == 0 ) {
157 14 100       67 $formatter->_failure_output(
158             $total
159             ? "All $total subtests passed "
160             : 'No subtests run '
161             );
162             }
163             else {
164 23         141 $formatter->_failure_output("Failed $failed/$total subtests ");
165 23 50       132 if ( !$total ) {
166 0         0 $formatter->_failure_output("\nNo tests run!");
167             }
168             }
169              
170 37 50       113 if ( my $skipped = $parser->skipped ) {
171 0         0 $passed -= $skipped;
172 0 0       0 my $test = 'subtest' . ( $skipped != 1 ? 's' : '' );
173 0         0 $formatter->_output(
174             "\n\t(less $skipped skipped $test: $passed okay)");
175             }
176              
177 37 50       95 if ( my $failed = $parser->todo_passed ) {
178 0 0       0 my $test = $failed > 1 ? 'tests' : 'test';
179 0         0 $formatter->_output(
180             "\n\t($failed TODO $test unexpectedly succeeded)");
181             }
182              
183 37         97 $formatter->_output("\n");
184             }
185              
186             sub _make_ok_line {
187 42     42   60 my ( $self, $suffix ) = @_;
188 42         244 return "ok$suffix\n";
189             }
190              
191             sub time_report {
192 42     42 1 59 my ( $self, $formatter, $parser ) = @_;
193              
194 42         65 my @time_report;
195 42 50       105 if ( $formatter->timer ) {
196 0         0 my $start_time = $parser->start_time;
197 0         0 my $end_time = $parser->end_time;
198 0 0 0     0 if ( defined $start_time and defined $end_time ) {
199 0         0 my $elapsed = $end_time - $start_time;
200 0 0 0     0 push @time_report,
201             $self->time_is_hires
202             ? sprintf( ' %8d ms', $elapsed * 1000 )
203             : sprintf( ' %8s s', $elapsed || '<1' );
204             }
205 0         0 my $start_times = $parser->start_times();
206 0         0 my $end_times = $parser->end_times();
207 0         0 my $usr = $end_times->[0] - $start_times->[0];
208 0         0 my $sys = $end_times->[1] - $start_times->[1];
209 0         0 my $cusr = $end_times->[2] - $start_times->[2];
210 0         0 my $csys = $end_times->[3] - $start_times->[3];
211 0         0 push @time_report,
212             sprintf('(%5.2f usr %5.2f sys + %5.2f cusr %5.2f csys = %5.2f CPU)',
213             $usr, $sys, $cusr, $csys,
214             $usr + $sys + $cusr + $csys);
215             }
216              
217 42         179 return "@time_report";
218             }
219              
220             1;