chromatic wrote code that only reports test failures and I liked it so much that I stole it to report passing tests in green and failing tests in red. This is just a proof of concept and may get expanded, which is why I didn't toss this into Code Catacombs.

The major problem with this lies in Test::Harness's annoying habit of printing failure output directly to STDERR, so you cannot currently have the normal "got/expected" behavior lining up with the pretty red failure message. That behavior might get fixed at some point.

In the meantime, feel free to play with this and comment on it. It needs some work.

#!/usr/bin/perl

use strict;
use warnings;

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

use constant SUCCESS => color 'bold green';
use constant FAILURE => color 'bold red';
use constant SKIP    => color 'bold yellow';
use constant RESET   => color 'reset';

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 SUCCESS;
        print( sprintf("All (%d) tests passed in %s\n",  $results{seen
+}, $file));
    }
    elsif ($results{skip_all}) {
        print SKIP;
        print sprintf("All (%d) tests skipped in %s\n", $results{seen}
+, $file);
    }
    else {
        print FAILURE;
        print "$header\n";
    }
    foreach my $result (@$results) {
        if ($result->{test}{ok}) {
            print SUCCESS;
        }
        else {
            print FAILURE;
        }
        print $result->{output};
    }
    print RESET;
}

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

    my @results;
    for my $test ( @{ $results->{details} } ) {
        $count++;
        push @results => {
            test   => $test,
            output => create_test_result( $test->{ok}, $count, @{ $tes
+t }{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 / Faile
+d %d\n",
        @_, $failed;
}

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

[download]

Cheers,
Ovid

New address of my CGI Course.

Replies are listed 'Best First'.
Re: See your test results in color.
by dragonchild (Archbishop) on Jan 26, 2005 at 20:07 UTC
    My tester looks like: 
    my @failures;
foreach my $file (<t/*.t>) {
    local *STDERR;
    my %results = eval { $tester->analyze_file( $file ); };

    push @failures, $file unless $results{passing};
}

if (@failures) {
    print scalar(@failures), " files failed.\n";
    local $"=$/;
    print "@failures\n";
}
else {
    print "All tests succeeded.\n";
}

    [download]

    You'll want the eval, just in case something dies in your test file, like a missing method name. The local *STDERR; seems to shut Test::Harness up. YMMV.

    Being right, does not endow the right to be rude; politeness costs nothing.
    Being unknowing, is not the same as being stupid.
    Expressing a contrary opinion, whether to the individual or the group, is more often a sign of deeper thought than of cantankerous belligerence.
    Do not mistake your goals as the only goals; your opinion as the only opinion; your confidence as correctness. Saying you know better is not the same as explaining you know better.

[reply]
[d/l]
[select]

      Oh, duh! Yeah, I need the eval so the terminal colors don't get messed up. Good point.

      Rather than shut Test::Harness up, I'd rather do something like Tie::STDERR, figure out where the output belongs and synchronize it with the results, but I don't think there's any way of knowing which output to STDERR corresponds to a particular test.

      Cheers,
      Ovid

      New address of my CGI Course.

[reply]

        Well, you could always redirect STDERR to STDOUT like 

        local *STDERR;
open STDERR, ">&STDOUT" or die "cannot dup STDERR to STDOUT: $!\n";

        [download]

        And then deal with only one output stream...

        radiantmatrix
        require General::Disclaimer;
        s//2fde04abe76c036c9074586c1/; while(m/(.)/g){print substr(' ,JPacehklnorstu',hex($1),1)}

[reply]
[d/l]

Back to Meditations