Commit | Line | Data |
b965d173 |
1 | package TAP::Formatter::Console::Session; |
2 | |
3 | use strict; |
4 | use TAP::Base; |
5 | |
6 | use vars qw($VERSION @ISA); |
7 | |
8 | @ISA = qw(TAP::Base); |
9 | |
10 | my @ACCESSOR; |
11 | |
12 | BEGIN { |
13 | |
27fc0087 |
14 | @ACCESSOR = qw( name formatter parser show_count ); |
b965d173 |
15 | |
16 | for my $method (@ACCESSOR) { |
17 | no strict 'refs'; |
18 | *$method = sub { shift->{$method} }; |
19 | } |
20 | |
27fc0087 |
21 | my @CLOSURE_BINDING = qw( header result clear_for_close close_test ); |
b965d173 |
22 | |
23 | for my $method (@CLOSURE_BINDING) { |
24 | no strict 'refs'; |
25 | *$method = sub { |
26 | my $self = shift; |
27 | return ( $self->{_closures} ||= $self->_closures )->{$method} |
28 | ->(@_); |
29 | }; |
30 | } |
31 | } |
32 | |
33 | =head1 NAME |
34 | |
35 | TAP::Formatter::Console::Session - Harness output delegate for default console output |
36 | |
37 | =head1 VERSION |
38 | |
27fc0087 |
39 | Version 3.14 |
b965d173 |
40 | |
41 | =cut |
42 | |
27fc0087 |
43 | $VERSION = '3.14'; |
b965d173 |
44 | |
45 | =head1 DESCRIPTION |
46 | |
47 | This provides console orientated output formatting for TAP::Harness. |
48 | |
49 | =head1 SYNOPSIS |
50 | |
51 | =cut |
52 | |
53 | =head1 METHODS |
54 | |
55 | =head2 Class Methods |
56 | |
57 | =head3 C<new> |
58 | |
59 | my %args = ( |
60 | formatter => $self, |
61 | ) |
62 | my $harness = TAP::Formatter::Console::Session->new( \%args ); |
63 | |
64 | The constructor returns a new C<TAP::Formatter::Console::Session> object. |
65 | |
66 | =over 4 |
67 | |
68 | =item * C<formatter> |
69 | |
70 | =item * C<parser> |
71 | |
72 | =item * C<name> |
73 | |
27fc0087 |
74 | =item * C<show_count> |
75 | |
b965d173 |
76 | =back |
77 | |
78 | =cut |
79 | |
80 | sub _initialize { |
81 | my ( $self, $arg_for ) = @_; |
82 | $arg_for ||= {}; |
83 | |
84 | $self->SUPER::_initialize($arg_for); |
85 | my %arg_for = %$arg_for; # force a shallow copy |
86 | |
87 | for my $name (@ACCESSOR) { |
88 | $self->{$name} = delete $arg_for{$name}; |
89 | } |
90 | |
27fc0087 |
91 | if ( !defined $self->show_count ) { |
92 | $self->{show_count} = 1; # defaults to true |
93 | } |
94 | if ( $self->show_count ) { # but may be a damned lie! |
95 | $self->{show_count} = $self->_should_show_count; |
96 | } |
97 | |
b965d173 |
98 | if ( my @props = sort keys %arg_for ) { |
99 | $self->_croak("Unknown arguments to TAP::Harness::new (@props)"); |
100 | } |
101 | |
102 | return $self; |
103 | } |
104 | |
105 | =head3 C<header> |
106 | |
107 | Output test preamble |
108 | |
109 | =head3 C<result> |
110 | |
111 | Called by the harness for each line of TAP it receives. |
112 | |
113 | =head3 C<close_test> |
114 | |
115 | Called to close a test session. |
116 | |
27fc0087 |
117 | =head3 C<clear_for_close> |
118 | |
119 | Called by C<close_test> to clear the line showing test progress, or the parallel |
120 | test ruler, prior to printing the final test result. |
121 | |
b965d173 |
122 | =cut |
123 | |
124 | sub _get_output_result { |
125 | my $self = shift; |
126 | |
127 | my @color_map = ( |
128 | { test => sub { $_->is_test && !$_->is_ok }, |
129 | colors => ['red'], |
130 | }, |
131 | { test => sub { $_->is_test && $_->has_skip }, |
132 | colors => [ |
133 | 'white', |
134 | 'on_blue' |
135 | ], |
136 | }, |
137 | { test => sub { $_->is_test && $_->has_todo }, |
138 | colors => ['yellow'], |
139 | }, |
140 | ); |
141 | |
142 | my $formatter = $self->formatter; |
143 | my $parser = $self->parser; |
144 | |
145 | return $formatter->_colorizer |
146 | ? sub { |
147 | my $result = shift; |
148 | for my $col (@color_map) { |
149 | local $_ = $result; |
150 | if ( $col->{test}->() ) { |
151 | $formatter->_set_colors( @{ $col->{colors} } ); |
152 | last; |
153 | } |
154 | } |
155 | $formatter->_output( $result->as_string ); |
156 | $formatter->_set_colors('reset'); |
157 | } |
158 | : sub { |
159 | $formatter->_output( shift->as_string ); |
160 | }; |
161 | } |
162 | |
163 | sub _closures { |
164 | my $self = shift; |
165 | |
166 | my $parser = $self->parser; |
167 | my $formatter = $self->formatter; |
b965d173 |
168 | my $pretty = $formatter->_format_name( $self->name ); |
27fc0087 |
169 | my $show_count = $self->show_count; |
b965d173 |
170 | |
171 | my $really_quiet = $formatter->really_quiet; |
172 | my $quiet = $formatter->quiet; |
173 | my $verbose = $formatter->verbose; |
174 | my $directives = $formatter->directives; |
175 | my $failures = $formatter->failures; |
176 | |
177 | my $output_result = $self->_get_output_result; |
178 | |
179 | my $output = '_output'; |
180 | my $plan = ''; |
181 | my $newline_printed = 0; |
182 | |
183 | my $last_status_printed = 0; |
184 | |
185 | return { |
186 | header => sub { |
187 | $formatter->_output($pretty) |
188 | unless $really_quiet; |
189 | }, |
190 | |
191 | result => sub { |
192 | my $result = shift; |
193 | |
194 | if ( $result->is_bailout ) { |
195 | $formatter->_failure_output( |
196 | "Bailout called. Further testing stopped: " |
197 | . $result->explanation |
198 | . "\n" ); |
199 | } |
200 | |
201 | return if $really_quiet; |
202 | |
203 | my $is_test = $result->is_test; |
204 | |
205 | # These are used in close_test - but only if $really_quiet |
206 | # is false - so it's safe to only set them here unless that |
207 | # relationship changes. |
208 | |
209 | if ( !$plan ) { |
210 | my $planned = $parser->tests_planned || '?'; |
211 | $plan = "/$planned "; |
212 | } |
213 | $output = $formatter->_get_output_method($parser); |
214 | |
215 | if ( $show_count and $is_test ) { |
216 | my $number = $result->number; |
217 | my $now = CORE::time; |
218 | |
27fc0087 |
219 | # Print status roughly once per second. |
220 | # We will always get the first number as a side effect of |
221 | # $last_status_printed starting with the value 0, which $now |
222 | # will never be. (Unless someone sets their clock to 1970) |
223 | if ( $last_status_printed != $now ) { |
b965d173 |
224 | $formatter->$output("\r$pretty$number$plan"); |
225 | $last_status_printed = $now; |
226 | } |
227 | } |
228 | |
229 | if (!$quiet |
230 | && ( ( $verbose && !$failures ) |
231 | || ( $is_test && $failures && !$result->is_ok ) |
232 | || ( $result->has_directive && $directives ) ) |
233 | ) |
234 | { |
235 | unless ($newline_printed) { |
236 | $formatter->_output("\n"); |
237 | $newline_printed = 1; |
238 | } |
239 | $output_result->($result); |
240 | $formatter->_output("\n"); |
241 | } |
242 | }, |
243 | |
27fc0087 |
244 | clear_for_close => sub { |
245 | my $spaces = ' ' x |
246 | length( '.' . $pretty . $plan . $parser->tests_run ); |
247 | $formatter->$output("\r$spaces"); |
248 | }, |
249 | |
b965d173 |
250 | close_test => sub { |
27fc0087 |
251 | if ($show_count && !$really_quiet) { |
252 | $self->clear_for_close; |
253 | $formatter->$output("\r$pretty"); |
254 | } |
f7c69158 |
255 | |
256 | # Avoid circular references |
257 | $self->parser(undef); |
258 | $self->{_closures} = {}; |
259 | |
b965d173 |
260 | return if $really_quiet; |
261 | |
b965d173 |
262 | if ( my $skip_all = $parser->skip_all ) { |
263 | $formatter->_output("skipped: $skip_all\n"); |
264 | } |
265 | elsif ( $parser->has_problems ) { |
266 | $self->_output_test_failure($parser); |
267 | } |
268 | else { |
269 | my $time_report = ''; |
270 | if ( $formatter->timer ) { |
271 | my $start_time = $parser->start_time; |
272 | my $end_time = $parser->end_time; |
273 | if ( defined $start_time and defined $end_time ) { |
274 | my $elapsed = $end_time - $start_time; |
275 | $time_report |
276 | = $self->time_is_hires |
277 | ? sprintf( ' %8d ms', $elapsed * 1000 ) |
278 | : sprintf( ' %8s s', $elapsed || '<1' ); |
279 | } |
280 | } |
281 | |
282 | $formatter->_output("ok$time_report\n"); |
283 | } |
284 | }, |
285 | }; |
286 | } |
287 | |
288 | sub _should_show_count { |
289 | |
290 | # we need this because if someone tries to redirect the output, it can get |
291 | # very garbled from the carriage returns (\r) in the count line. |
292 | return !shift->formatter->verbose && -t STDOUT; |
293 | } |
294 | |
295 | sub _output_test_failure { |
296 | my ( $self, $parser ) = @_; |
297 | my $formatter = $self->formatter; |
298 | return if $formatter->really_quiet; |
299 | |
300 | my $tests_run = $parser->tests_run; |
301 | my $tests_planned = $parser->tests_planned; |
302 | |
303 | my $total |
304 | = defined $tests_planned |
305 | ? $tests_planned |
306 | : $tests_run; |
307 | |
308 | my $passed = $parser->passed; |
309 | |
310 | # The total number of fails includes any tests that were planned but |
311 | # didn't run |
312 | my $failed = $parser->failed + $total - $tests_run; |
313 | my $exit = $parser->exit; |
314 | |
b965d173 |
315 | if ( my $exit = $parser->exit ) { |
316 | my $wstat = $parser->wait; |
317 | my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat ); |
318 | $formatter->_failure_output(" Dubious, test returned $status\n"); |
319 | } |
320 | |
321 | if ( $failed == 0 ) { |
322 | $formatter->_failure_output( |
323 | $total |
324 | ? " All $total subtests passed " |
325 | : ' No subtests run ' |
326 | ); |
327 | } |
328 | else { |
329 | $formatter->_failure_output(" Failed $failed/$total subtests "); |
330 | if ( !$total ) { |
331 | $formatter->_failure_output("\nNo tests run!"); |
332 | } |
333 | } |
334 | |
335 | if ( my $skipped = $parser->skipped ) { |
336 | $passed -= $skipped; |
337 | my $test = 'subtest' . ( $skipped != 1 ? 's' : '' ); |
338 | $formatter->_output( |
339 | "\n\t(less $skipped skipped $test: $passed okay)"); |
340 | } |
341 | |
342 | if ( my $failed = $parser->todo_passed ) { |
343 | my $test = $failed > 1 ? 'tests' : 'test'; |
344 | $formatter->_output( |
345 | "\n\t($failed TODO $test unexpectedly succeeded)"); |
346 | } |
347 | |
348 | $formatter->_output("\n"); |
349 | } |
350 | |
351 | 1; |