Update Test-Harness to CPAN version 3.39
[perl.git] / cpan / Test-Harness / lib / TAP / Formatter / Session.pm
1 package TAP::Formatter::Session;
2
3 use strict;
4 use warnings;
5
6 use base 'TAP::Base';
7
8 my @ACCESSOR;
9
10 BEGIN {
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
22 TAP::Formatter::Session - Abstract base class for harness output delegate 
23
24 =head1 VERSION
25
26 Version 3.39
27
28 =cut
29
30 our $VERSION = '3.39';
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
43 The 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
59 sub _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
87 Output test preamble
88
89 =head3 C<result>
90
91 Called by the harness for each line of TAP it receives.
92
93 =head3 C<close_test>
94
95 Called to close a test session.
96
97 =head3 C<clear_for_close>
98
99 Called by C<close_test> to clear the line showing test progress, or the parallel
100 test ruler, prior to printing the final test result.
101
102 =head3 C<time_report>
103
104 Return a formatted string about the elapsed (wall-clock) time
105 and about the consumed CPU time.
106
107 =cut
108
109 sub header { }
110
111 sub result { }
112
113 sub close_test { }
114
115 sub clear_for_close { }
116
117 sub _should_show_count {
118     my $self = shift;
119     return
120          !$self->formatter->verbose
121       && -t $self->formatter->stdout
122       && !$ENV{HARNESS_NOTTY};
123 }
124
125 sub _format_for_output {
126     my ( $self, $result ) = @_;
127     return $self->formatter->normalize ? $result->as_string : $result->raw;
128 }
129
130 sub _output_test_failure {
131     my ( $self, $parser ) = @_;
132     my $formatter = $self->formatter;
133     return if $formatter->really_quiet;
134
135     my $tests_run     = $parser->tests_run;
136     my $tests_planned = $parser->tests_planned;
137
138     my $total
139       = defined $tests_planned
140       ? $tests_planned
141       : $tests_run;
142
143     my $passed = $parser->passed;
144
145     # The total number of fails includes any tests that were planned but
146     # didn't run
147     my $failed = $parser->failed + $total - $tests_run;
148     my $exit   = $parser->exit;
149
150     if ( my $exit = $parser->exit ) {
151         my $wstat = $parser->wait;
152         my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat );
153         $formatter->_failure_output("Dubious, test returned $status\n");
154     }
155
156     if ( $failed == 0 ) {
157         $formatter->_failure_output(
158             $total
159             ? "All $total subtests passed "
160             : 'No subtests run '
161         );
162     }
163     else {
164         $formatter->_failure_output("Failed $failed/$total subtests ");
165         if ( !$total ) {
166             $formatter->_failure_output("\nNo tests run!");
167         }
168     }
169
170     if ( my $skipped = $parser->skipped ) {
171         $passed -= $skipped;
172         my $test = 'subtest' . ( $skipped != 1 ? 's' : '' );
173         $formatter->_output(
174             "\n\t(less $skipped skipped $test: $passed okay)");
175     }
176
177     if ( my $failed = $parser->todo_passed ) {
178         my $test = $failed > 1 ? 'tests' : 'test';
179         $formatter->_output(
180             "\n\t($failed TODO $test unexpectedly succeeded)");
181     }
182
183     $formatter->_output("\n");
184 }
185
186 sub _make_ok_line {
187     my ( $self, $suffix ) = @_;
188     return "ok$suffix\n";
189 }
190
191 sub time_report {
192     my ( $self, $formatter, $parser ) = @_;
193
194     my @time_report;
195     if ( $formatter->timer ) {
196         my $start_time = $parser->start_time;
197         my $end_time   = $parser->end_time;
198         if ( defined $start_time and defined $end_time ) {
199             my $elapsed = $end_time - $start_time;
200             push @time_report,
201               $self->time_is_hires
202                 ? sprintf( ' %8d ms', $elapsed * 1000 )
203                 : sprintf( ' %8s s', $elapsed || '<1' );
204         }
205         my $start_times = $parser->start_times();
206         my $end_times   = $parser->end_times();
207         my $usr  = $end_times->[0] - $start_times->[0];
208         my $sys  = $end_times->[1] - $start_times->[1];
209         my $cusr = $end_times->[2] - $start_times->[2];
210         my $csys = $end_times->[3] - $start_times->[3];
211         push @time_report,
212           sprintf('(%5.2f usr %5.2f sys + %5.2f cusr %5.2f csys = %5.2f CPU)',
213                   $usr, $sys, $cusr, $csys,
214                   $usr + $sys + $cusr + $csys);
215     }
216
217     return "@time_report";
218 }
219
220 1;