Making Test::Harness output a progress bar

I really haven't done a huge amount of work on Test::Harness since it was released as core, so I decided to take a look at how it is now. I was reading a blog post where someone commented that Perl's Test::Class doesn't offer a progress bar and I thought, that should be easy to hack into prove.

The way to do this now is to write a plugin for App::Prove, bundled with Test::Harness. Just create a package named App::Prove::Plugin::$PluginName and you can load it like this:

prove -P$PluginName t/

The plugin must provide a load method. Mine looks like this:

package App::Prove::Plugin::ProgressBar;

use strict;
use warnings;

my $NUM_TESTS;

sub load {
    my ( $class, $p ) = @_;
    $NUM_TESTS = $p->{app_prove}->_get_tests;
    $p->{app_prove}->formatter('App::Prove::Plugin::ProgressBar::Formatter');
    return 1;
}

The plugin architecture is not well-documented, so you have to do some digging through the code to understand all of it. There's also a couple of interesting things to note above.

First, _get_tests is not documented, so this is theoretically fragile. We use it, though, because we're going to base our progress bar on "X out of Y" test programs run.

Next, the formatter method is documented to take a formatter object, but in reality, it only takes a class name. This is why the $NUM_TESTS variable is declared with a file scope.

Now that we have a plugin, we need to write the formatter. Unfortunately, this will also take advantage of undocumented methods. My idea is to reuse TAP::Formatter::Console with "really_quiet" verbosity. This turns off most of Test::Harness's output, only emitting test failures and the summary. That's exactly what I need. Note that this is in the same file as the plugin and we use the $NUM_TESTS variable here (a bit of a hack to get around the formatter bug).

package App::Prove::Plugin::ProgressBar::Formatter;
use Term::ProgressBar;
use parent 'TAP::Formatter::Console';
__PACKAGE__->mk_methods(qw[progress curr_prog is_failing]);

sub new {
    my ( $class, $args ) = @_;
    # The -2 is 'really_quiet', but it's not well-documented
    $args->{verbosity} = -2;
    my $self     = $class->SUPER::new($args);
    my $progress = Term::ProgressBar->new(
        {
            name  => 'Test Programs Run',
            count => $NUM_TESTS,
        }
    );
    $self->progress($progress);
    $self->curr_prog(1);
    $self->_set_colors('green');
    return $self;
}

sub open_test {
    my ( $self, $test, $parser ) = @_;
    $parser->callback(
        EOF => sub {
            $self->_set_colors('red') if $self->is_failing;
            $self->progress->update( $self->curr_prog );
            $self->_set_colors('reset');
            $self->curr_prog( $self->curr_prog + 1 );
        }
    );
    $parser->callback(
        test => sub {
            my $test = shift;
            if ( not $test->is_ok ) {
                print "\r", ( ' ' x $self->progress->term_width );
                $self->is_failing(1);
            }
        }
    );
    $self->SUPER::open_test( $test, $parser );
}

I had originally used Term::ANSIColor in the formatter for color support, but I remembered that I can access it through my parent formatter and that handles colours on Windows as well. Again, this is digging through the code and is not well documented.

The open_test method is where the magic is. We set up a parser callback for EOF (end of each test program). The progress bar starts out as green, but if there are any test failures (checked in the test callback), we set the output to red for the rest of the progress bar run. The callback then updates the progress bar and bumps up the curr_prog() value, thus allowing the progress bar to have a correct value in the future.

Also, note this odd line in the test callback:

print "\r", ( ' ' x $self->progress->term_width );

That merely puts us to the start of the line and prints spaces equal to what the progress bar thinks the term width is (another undocumented method). This is to print spaces over the progress bar if there are failures. This is needed because when the test output is printed on failure and we don't wipe out the progress bar, we get a partial progress bar scrolling up the screen.

Put all this together and you can do this:

prove -PProgressBar t/

And now you have a red/green progress bar for your test runs instead of a list of files spewing over the screen. It's on github if you want to play with it.

About Ovid

user-pic Freelance Perl/Testing/Agile consultant and trainer. See http://www.allaroundtheworld.fr/ for our services. If you have a problem with Perl, we will solve it for you. And don't forget to buy my book! http://www.amazon.com/Beginning-Perl-Curtis-Poe/dp/1118013840/