ext/Test/Harness/lib/TAP/Formatter/Console/Session.pm

   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
  14     @ACCESSOR = qw( name formatter parser show_count );
  15
  16     for my $method (@ACCESSOR) {
  17         no strict 'refs';
  18         *$method = sub { shift->{$method} };
  19     }
  20
  21     my @CLOSURE_BINDING = qw( header result clear_for_close close_test );
  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
  39 Version 3.14
  40
  41 =cut
  42
  43 $VERSION = '3.14';
  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
  74 =item * C<show_count>
  75
  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
  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
  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
 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
 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;
 168     my $pretty     = $formatter->_format_name( $self->name );
 169     my $show_count = $self->show_count;
 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
 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 ) {
 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
 244         clear_for_close => sub {
 245             my $spaces = ' ' x
 246               length( '.' . $pretty . $plan . $parser->tests_run );
 247             $formatter->$output("\r$spaces");
 248         },
 249
 250         close_test => sub {
 251             if ($show_count && !$really_quiet) {
 252                 $self->clear_for_close;
 253                 $formatter->$output("\r$pretty");
 254             }
 255
 256             # Avoid circular references
 257             $self->parser(undef);
 258             $self->{_closures} = {};
 259
 260             return if $really_quiet;
 261
 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
 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;