Commit | Line | Data |
bdaf8c65 |
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 | |
a39e16d8 |
28 | Version 3.17 |
bdaf8c65 |
29 | |
30 | =cut |
31 | |
a39e16d8 |
32 | $VERSION = '3.17'; |
bdaf8c65 |
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 |
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 |
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 | |
183 | 1; |