local-lib5/lib/perl5/TAP/Formatter/Session.pm

   1 package TAP::Formatter::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
  22 =head1 NAME
  23
  24 TAP::Formatter::Session - Abstract base class for harness output delegate
  25
  26 =head1 VERSION
  27
  28 Version 3.17
  29
  30 =cut
  31
  32 $VERSION = '3.17';
  33
  34 =head1 METHODS
  35
  36 =head2 Class Methods
  37
  38 =head3 C<new>
  39
  40  my %args = (
  41     formatter => $self,
  42  )
  43  my $harness = TAP::Formatter::Console::Session->new( \%args );
  44
  45 The constructor returns a new C<TAP::Formatter::Console::Session> object.
  46
  47 =over 4
  48
  49 =item * C<formatter>
  50
  51 =item * C<parser>
  52
  53 =item * C<name>
  54
  55 =item * C<show_count>
  56
  57 =back
  58
  59 =cut
  60
  61 sub _initialize {
  62     my ( $self, $arg_for ) = @_;
  63     $arg_for ||= {};
  64
  65     $self->SUPER::_initialize($arg_for);
  66     my %arg_for = %$arg_for;    # force a shallow copy
  67
  68     for my $name (@ACCESSOR) {
  69         $self->{$name} = delete $arg_for{$name};
  70     }
  71
  72     if ( !defined $self->show_count ) {
  73         $self->{show_count} = 1;    # defaults to true
  74     }
  75     if ( $self->show_count ) {      # but may be a damned lie!
  76         $self->{show_count} = $self->_should_show_count;
  77     }
  78
  79     if ( my @props = sort keys %arg_for ) {
  80         $self->_croak(
  81             "Unknown arguments to " . __PACKAGE__ . "::new (@props)" );
  82     }
  83
  84     return $self;
  85 }
  86
  87 =head3 C<header>
  88
  89 Output test preamble
  90
  91 =head3 C<result>
  92
  93 Called by the harness for each line of TAP it receives.
  94
  95 =head3 C<close_test>
  96
  97 Called to close a test session.
  98
  99 =head3 C<clear_for_close>
 100
 101 Called by C<close_test> to clear the line showing test progress, or the parallel
 102 test ruler, prior to printing the final test result.
 103
 104 =cut
 105
 106 sub header { }
 107
 108 sub result { }
 109
 110 sub close_test { }
 111
 112 sub clear_for_close { }
 113
 114 sub _should_show_count {
 115     my $self = shift;
 116     return
 117          !$self->formatter->verbose
 118       && -t $self->formatter->stdout
 119       && !$ENV{HARNESS_NOTTY};
 120 }
 121
 122 sub _format_for_output {
 123     my ( $self, $result ) = @_;
 124     return $self->formatter->normalize ? $result->as_string : $result->raw;
 125 }
 126
 127 sub _output_test_failure {
 128     my ( $self, $parser ) = @_;
 129     my $formatter = $self->formatter;
 130     return if $formatter->really_quiet;
 131
 132     my $tests_run     = $parser->tests_run;
 133     my $tests_planned = $parser->tests_planned;
 134
 135     my $total
 136       = defined $tests_planned
 137       ? $tests_planned
 138       : $tests_run;
 139
 140     my $passed = $parser->passed;
 141
 142     # The total number of fails includes any tests that were planned but
 143     # didn't run
 144     my $failed = $parser->failed + $total - $tests_run;
 145     my $exit   = $parser->exit;
 146
 147     if ( my $exit = $parser->exit ) {
 148         my $wstat = $parser->wait;
 149         my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat );
 150         $formatter->_failure_output("Dubious, test returned $status\n");
 151     }
 152
 153     if ( $failed == 0 ) {
 154         $formatter->_failure_output(
 155             $total
 156             ? "All $total subtests passed "
 157             : 'No subtests run '
 158         );
 159     }
 160     else {
 161         $formatter->_failure_output("Failed $failed/$total subtests ");
 162         if ( !$total ) {
 163             $formatter->_failure_output("\nNo tests run!");
 164         }
 165     }
 166
 167     if ( my $skipped = $parser->skipped ) {
 168         $passed -= $skipped;
 169         my $test = 'subtest' . ( $skipped != 1 ? 's' : '' );
 170         $formatter->_output(
 171             "\n\t(less $skipped skipped $test: $passed okay)");
 172     }
 173
 174     if ( my $failed = $parser->todo_passed ) {
 175         my $test = $failed > 1 ? 'tests' : 'test';
 176         $formatter->_output(
 177             "\n\t($failed TODO $test unexpectedly succeeded)");
 178     }
 179
 180     $formatter->_output("\n");
 181 }
 182
 183 1;