Commit | Line | Data |
---|---|---|
bdaf8c65 SH |
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 | ||
dbd04185 | 28 | Version 3.28 |
bdaf8c65 SH |
29 | |
30 | =cut | |
31 | ||
dbd04185 | 32 | $VERSION = '3.28'; |
bdaf8c65 SH |
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; | |
a39e16d8 SP |
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; | |
bdaf8c65 SH |
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 | ||
f0e2c26d CBW |
183 | sub _make_ok_line { |
184 | my ( $self, $suffix ) = @_; | |
185 | return "ok$suffix\n"; | |
186 | } | |
187 | ||
bdaf8c65 | 188 | 1; |