1 package TAP::Formatter::Console::ParallelSession;
6 use TAP::Formatter::Console::Session;
9 use constant WIDTH => 72; # Because Eric says
10 use vars qw($VERSION @ISA);
12 @ISA = qw(TAP::Formatter::Console::Session);
17 my ( $self, $arg_for ) = @_;
19 $self->SUPER::_initialize($arg_for);
20 my $formatter = $self->formatter;
22 # Horrid bodge. This creates our shared context per harness. Maybe
23 # TAP::Harness should give us this?
24 my $context = $shared{$formatter} ||= $self->_create_shared_context;
25 push @{ $context->{active} }, $self;
30 sub _create_shared_context {
41 TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel console output
53 This provides console orientated output formatting for L<TAP::Harness>
54 when run with multiple L<TAP::Harness/jobs>.
75 $self->formatter->_output( "\r" . ( ' ' x WIDTH ) . "\r" );
81 my $trailer = '... )===';
82 my $chop_length = WIDTH - length $trailer;
85 my ($self, $refresh) = @_;
87 return if $new_now == $now and !$refresh;
90 my $formatter = $self->formatter;
91 return if $formatter->really_quiet;
93 my $context = $shared{$formatter};
95 my $ruler = sprintf '===( %7d;%d ', $context->{tests}, $now - $start;
97 foreach my $active ( @{$context->{active}} ) {
98 my $parser = $active->parser;
99 my $tests = $parser->tests_run;
100 my $planned = $parser->tests_planned || '?';
102 $ruler .= sprintf '%' . length ($planned) . "d/$planned ", $tests;
104 chop $ruler; # Remove a trailing space
107 if ( length $ruler > WIDTH ) {
108 $ruler =~ s/(.{$chop_length}).*/$1$trailer/o;
111 $ruler .= '=' x ( WIDTH - length( $ruler ) );
113 $formatter->_output( "\r$ruler");
118 Called by the harness for each line of TAP it receives .
123 my ( $self, $result ) = @_;
124 my $formatter = $self->formatter;
126 # my $really_quiet = $formatter->really_quiet;
127 # my $show_count = $self->_should_show_count;
129 if ( $result->is_test ) {
130 my $context = $shared{$formatter};
133 my $active = $context->{active};
134 if ( @$active == 1 ) {
135 # There is only one test, so use the serial output format.
136 return $self->SUPER::result( $result );
139 $self->_output_ruler( $self->parser->tests_run == 1 );
141 elsif ( $result->is_bailout ) {
142 $formatter->_failure_output(
143 "Bailout called. Further testing stopped: "
144 . $result->explanation
149 =head3 C<clear_for_close>
153 sub clear_for_close {
155 my $formatter = $self->formatter;
156 return if $formatter->really_quiet;
157 my $context = $shared{$formatter};
158 if ( @{ $context->{active} } == 1 ) {
159 $self->SUPER::clear_for_close;
172 my $name = $self->name;
173 my $parser = $self->parser;
174 my $formatter = $self->formatter;
175 my $context = $shared{$formatter};
177 $self->SUPER::close_test;
179 my $active = $context->{active};
181 my @pos = grep { $active->[$_]->name eq $name } 0 .. $#$active;
183 die "Can't find myself" unless @pos;
184 splice @$active, $pos[0], 1;
187 $self->_output_ruler( 1 );
189 elsif (@$active == 1) {
190 # Print out "test/name.t ...."
191 $active->[0]->SUPER::header;
194 # $self->formatter->_output("\n");
195 delete $shared{$formatter};