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