xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Formatter/Session.pm (revision d13be5d47e4149db2549a9828e244d59dbc43f15)
1package TAP::Formatter::Session;
2
3use strict;
4use TAP::Base;
5
6use vars qw($VERSION @ISA);
7
8@ISA = qw(TAP::Base);
9
10my @ACCESSOR;
11
12BEGIN {
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
24TAP::Formatter::Session - Abstract base class for harness output delegate
25
26=head1 VERSION
27
28Version 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
45The 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
61sub _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
89Output test preamble
90
91=head3 C<result>
92
93Called by the harness for each line of TAP it receives.
94
95=head3 C<close_test>
96
97Called to close a test session.
98
99=head3 C<clear_for_close>
100
101Called by C<close_test> to clear the line showing test progress, or the parallel
102test ruler, prior to printing the final test result.
103
104=cut
105
106sub header { }
107
108sub result { }
109
110sub close_test { }
111
112sub clear_for_close { }
113
114sub _should_show_count {
115    my $self = shift;
116    return
117         !$self->formatter->verbose
118      && -t $self->formatter->stdout
119      && !$ENV{HARNESS_NOTTY};
120}
121
122sub _format_for_output {
123    my ( $self, $result ) = @_;
124    return $self->formatter->normalize ? $result->as_string : $result->raw;
125}
126
127sub _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
1831;
184