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 my $formatter = $self->formatter;
42 $shared{$formatter}->{need_refresh}++;
47 TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel console output
59 This provides console orientated output formatting for L<TAP::Harness::Parallel>.
85 $self->formatter->_output( "\r" . ( ' ' x WIDTH ) . "\r" );
90 my $formatter = $self->formatter;
91 return if $formatter->really_quiet;
93 my $context = $shared{$formatter};
95 my $ruler = sprintf( "===( %7d )", $context->{tests} );
96 $ruler .= ( '=' x ( WIDTH - length $ruler ) );
97 $formatter->_output("\r$ruler");
102 Called by the harness for each line of TAP it receives .
107 my ( $self, $result ) = @_;
108 my $parser = $self->parser;
109 my $formatter = $self->formatter;
110 my $context = $shared{$formatter};
114 # my $really_quiet = $formatter->really_quiet;
115 # my $show_count = $self->_should_show_count;
116 my $planned = $parser->tests_planned;
118 if ( $result->is_bailout ) {
119 $formatter->_failure_output(
120 "Bailout called. Further testing stopped: "
121 . $result->explanation
125 if ( $result->is_test ) {
128 my $test_print_modulus = 1;
129 my $ceiling = $context->{tests} / 5;
130 $test_print_modulus *= 2 while $test_print_modulus < $ceiling;
132 unless ( $context->{tests} % $test_print_modulus ) {
133 $self->_output_ruler;
144 my $name = $self->name;
145 my $parser = $self->parser;
146 my $formatter = $self->formatter;
147 my $context = $shared{$formatter};
149 unless ( $formatter->really_quiet ) {
152 # my $output = $self->_output_method;
154 $formatter->_format_name( $self->name ),
159 if ( $parser->has_problems ) {
160 $self->_output_test_failure($parser);
163 $formatter->_output("ok\n")
164 unless $formatter->really_quiet;
167 $self->_output_ruler;
169 # $self->SUPER::close_test;
170 my $active = $context->{active};
172 my @pos = grep { $active->[$_]->name eq $name } 0 .. $#$active;
174 die "Can't find myself" unless @pos;
175 splice @$active, $pos[0], 1;
177 $self->_need_refresh;
181 # $self->formatter->_output("\n");
182 delete $shared{$formatter};