Color tests (this time with code)

Ovid on 2005-01-26T18:59:27

I liked chromatic's qtest so much that I stole it to make colored test output. Unfortunately, there's no convenient way (that I know of) to stop Test::Harness from just spitting its failure results out as it finds them, so while this will give you pretty test output and make it dead simple to spot test failures, it will print the "got/expected" message prior to the given test file running. Bummer.

Still, I think the output is nice.

#!/usr/local/bin/perl

use strict;
use warnings;

use Term::ANSIColor;
use Test::Harness::Straps;

my $strap = Test::Harness::Straps->new();

for my $file (@ARGV) {
    next unless -f $file;

    my %results = $strap->analyze_file( $file );
    my ($header, $results) = process_results( $file, \%results );
    if ($results{passing}) {
        print color 'bold green';
        print( sprintf("All (%d) tests passed in %s\n",  $results{seen}, $file));
    }
    elsif ($results{skip_all}) {
        print color 'bold yellow';
        print sprintf("All (%d) tests skipped in %s\n", $results{seen}, $file);
    }
    else {
        print color 'bold red';
        print "$header\n";
    }
    foreach my $result (@$results) {
        if ($result->{test}{ok}) {
            print color 'bold green';
        }
        else {
            print color 'bold red';
        }
        print $result->{output};
    }
    print color 'reset';
}

sub process_results {
    my ($file, $results) = @_;
    my $report           = create_header($file, @{$results}{qw( max seen ok )});
    my $count            = 0;

    my @results;
    for my $test ( @{ $results->{details} } ) {
        $count++;
        push @results => {
            test   => $test,
            output => create_test_result( $test->{ok}, $count, @{ $test }{qw( name reason ) } )
        }
    }

    return ($report, \@results);
}

sub create_header {
    my ($file, $expected, $seen, $passed) = @_;
    my $failed                            = $seen - $passed;
    return sprintf "File '%s'\nExpected %d / Seen %d / Okay %d / Failed %d\n",
        @_, $failed;
}

sub create_test_result {
    my ($ok, $number, $name, $reason)   = @_;
    $ok = $ok ? 'ok' : 'not ok';
    $reason                      ||= '';
    $reason                        = " ($reason)" if $reason;
    return sprintf "%6s %4d %s%s\n", $ok, $number, $name, $reason;
}

Test::Harness and Diagnostics

chromatic on 2005-01-26T19:30:22

How interesting! I hadn't noticed that T::H spits out diagnostics on STDERR. Perhaps it should (optionally) capture them and store them in the individual test results. Andy, would you put up with that?

Re:Test::Harness and Diagnostics

Ovid on 2005-01-26T19:36:46

I would be ecstatic if it did that. Then this could be a general purpose tool that could be either incorporated into prove or stand alongside it. It would be trivial to add switches to only show passing tests, too.

Re:Test::Harness and Diagnostics

petdance on 2005-01-26T19:41:22

Certainly seems reasonable.