Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Ovid (2709)

  (email not shown publicly)
AOL IM: ovidperl (Add Buddy, Send Message)

Stuff with the Perl Foundation. A couple of patches in the Perl core. A few CPAN modules. That about sums it up.

Journal of Ovid (2709)

Wednesday January 26, 2005
01:59 PM

Color tests (this time with code)

[ #22899 ]

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.


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} } ) {
        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;

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.