1 package TAP::Formatter::Console::Session;
6 use vars qw($VERSION @ISA);
14 @ACCESSOR = qw( name formatter parser );
16 for my $method (@ACCESSOR) {
18 *$method = sub { shift->{$method} };
21 my @CLOSURE_BINDING = qw( header result close_test );
23 for my $method (@CLOSURE_BINDING) {
27 return ( $self->{_closures} ||= $self->_closures )->{$method}
35 TAP::Formatter::Console::Session - Harness output delegate for default console output
47 This provides console orientated output formatting for TAP::Harness.
62 my $harness = TAP::Formatter::Console::Session->new( \%args );
64 The constructor returns a new C<TAP::Formatter::Console::Session> object.
79 my ( $self, $arg_for ) = @_;
82 $self->SUPER::_initialize($arg_for);
83 my %arg_for = %$arg_for; # force a shallow copy
85 for my $name (@ACCESSOR) {
86 $self->{$name} = delete $arg_for{$name};
89 if ( my @props = sort keys %arg_for ) {
90 $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
102 Called by the harness for each line of TAP it receives.
106 Called to close a test session.
110 sub _get_output_result {
114 { test => sub { $_->is_test && !$_->is_ok },
117 { test => sub { $_->is_test && $_->has_skip },
123 { test => sub { $_->is_test && $_->has_todo },
124 colors => ['yellow'],
128 my $formatter = $self->formatter;
129 my $parser = $self->parser;
131 return $formatter->_colorizer
134 for my $col (@color_map) {
136 if ( $col->{test}->() ) {
137 $formatter->_set_colors( @{ $col->{colors} } );
141 $formatter->_output( $result->as_string );
142 $formatter->_set_colors('reset');
145 $formatter->_output( shift->as_string );
152 my $parser = $self->parser;
153 my $formatter = $self->formatter;
154 my $show_count = $self->_should_show_count;
155 my $pretty = $formatter->_format_name( $self->name );
157 my $really_quiet = $formatter->really_quiet;
158 my $quiet = $formatter->quiet;
159 my $verbose = $formatter->verbose;
160 my $directives = $formatter->directives;
161 my $failures = $formatter->failures;
163 my $output_result = $self->_get_output_result;
165 my $output = '_output';
167 my $newline_printed = 0;
169 my $last_status_printed = 0;
173 $formatter->_output($pretty)
174 unless $really_quiet;
180 if ( $result->is_bailout ) {
181 $formatter->_failure_output(
182 "Bailout called. Further testing stopped: "
183 . $result->explanation
187 return if $really_quiet;
189 my $is_test = $result->is_test;
191 # These are used in close_test - but only if $really_quiet
192 # is false - so it's safe to only set them here unless that
193 # relationship changes.
196 my $planned = $parser->tests_planned || '?';
197 $plan = "/$planned ";
199 $output = $formatter->_get_output_method($parser);
201 if ( $show_count and $is_test ) {
202 my $number = $result->number;
203 my $now = CORE::time;
205 # Print status on first number, and roughly once per second
206 if ( ( $number == 1 )
207 || ( $last_status_printed != $now ) )
209 $formatter->$output("\r$pretty$number$plan");
210 $last_status_printed = $now;
215 && ( ( $verbose && !$failures )
216 || ( $is_test && $failures && !$result->is_ok )
217 || ( $result->has_directive && $directives ) )
220 unless ($newline_printed) {
221 $formatter->_output("\n");
222 $newline_printed = 1;
224 $output_result->($result);
225 $formatter->_output("\n");
230 return if $really_quiet;
234 length( '.' . $pretty . $plan . $parser->tests_run );
235 $formatter->$output("\r$spaces\r$pretty");
238 if ( my $skip_all = $parser->skip_all ) {
239 $formatter->_output("skipped: $skip_all\n");
241 elsif ( $parser->has_problems ) {
242 $self->_output_test_failure($parser);
245 my $time_report = '';
246 if ( $formatter->timer ) {
247 my $start_time = $parser->start_time;
248 my $end_time = $parser->end_time;
249 if ( defined $start_time and defined $end_time ) {
250 my $elapsed = $end_time - $start_time;
252 = $self->time_is_hires
253 ? sprintf( ' %8d ms', $elapsed * 1000 )
254 : sprintf( ' %8s s', $elapsed || '<1' );
258 $formatter->_output("ok$time_report\n");
264 sub _should_show_count {
266 # we need this because if someone tries to redirect the output, it can get
267 # very garbled from the carriage returns (\r) in the count line.
268 return !shift->formatter->verbose && -t STDOUT;
271 sub _output_test_failure {
272 my ( $self, $parser ) = @_;
273 my $formatter = $self->formatter;
274 return if $formatter->really_quiet;
276 my $tests_run = $parser->tests_run;
277 my $tests_planned = $parser->tests_planned;
280 = defined $tests_planned
284 my $passed = $parser->passed;
286 # The total number of fails includes any tests that were planned but
288 my $failed = $parser->failed + $total - $tests_run;
289 my $exit = $parser->exit;
291 # TODO: $flist isn't used anywhere
292 # my $flist = join ", " => $formatter->range( $parser->failed );
294 if ( my $exit = $parser->exit ) {
295 my $wstat = $parser->wait;
296 my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat );
297 $formatter->_failure_output(" Dubious, test returned $status\n");
300 if ( $failed == 0 ) {
301 $formatter->_failure_output(
303 ? " All $total subtests passed "
304 : ' No subtests run '
308 $formatter->_failure_output(" Failed $failed/$total subtests ");
310 $formatter->_failure_output("\nNo tests run!");
314 if ( my $skipped = $parser->skipped ) {
316 my $test = 'subtest' . ( $skipped != 1 ? 's' : '' );
318 "\n\t(less $skipped skipped $test: $passed okay)");
321 if ( my $failed = $parser->todo_passed ) {
322 my $test = $failed > 1 ? 'tests' : 'test';
324 "\n\t($failed TODO $test unexpectedly succeeded)");
327 $formatter->_output("\n");