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