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