Stories
Slash Boxes
Comments
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)

Ovid
  (email not shown publicly)
http://publius-ovidius.livejournal.com/
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)

Thursday January 04, 2007
04:49 PM

Outputting failed test information

[ #32073 ]

Part of my current work with TAPx::Parser is to get the TAPx::Harness output as similar to Test::Harness output as I can. This turns out to be annoyingly tricky.

Failed Test         Stat Wstat Total Fail  List of Failed
------------------------------------------------------------------------ -------
runtests_example.pl    5  1280    13    5  3 5 10-12
(1 subtest UNEXPECTEDLY SUCCEEDED).
Failed 1/1 test scripts. 5/13 subtests failed.
Files=1, Tests=13,  0 wallclock secs ( 0.06 cusr +  0.02 csys =  0.08 CPU)
Failed 1/1 test programs. 5/13 subtests failed.

Test::Harness uses formats to get this right. While my code doesn't use formats, I have worked on getting the "List of Failed" ranges right with code similar to the following:

#!/usr/bin/perl

use strict;
use warnings;
use Test::More qw/no_plan/;

is join( ', ', range(qw( 33 34 35 37 99 100 101 )) ), '33-35, 37, 99-101';
is join( ', ', range(qw( 1 2 3 4)) ),                 '1-4';
is join( ', ', range(qw(1 2 5 6 7 9)) ),              '1-2, 5-7, 9';
is join( ', ', range(qw(17 19 33)) ),                 '17, 19, 33';
is join( ', ', range(qw(17 19)) ),                    '17, 19';

diag balanced_range( 15,
    range(qw(  1 2 3 5 7 9 20 33 34 35 37 99 100 101 )) );

sub balanced_range {
    my ( $limit, @range ) = @_;
    my $lines = "\t";
    my $curr  = 0;
    while (@range) {
        if ( $curr < $limit ) {
            my $range = ( shift @range ) . ", ";
            $lines .= $range;
            $curr += length $range;
        }
        elsif (@range) {
            $lines .= "\n\t";
            $curr = 0;
        }
    }
    $lines =~ s/, $//;
    return $lines;
}

sub range {
    my @numbers = @_;
    my ( $min, @range );

    foreach my $i ( 0 .. $#numbers ) {
        my $num  = $numbers[$i];
        my $next = $numbers[ $i + 1 ];
        if ( defined $next && $next == $num + 1 ) {
            if ( !defined $min ) {
                $min = $num;
            }
        }
        elsif ( defined $min ) {
            push @range => "$min-$num";
            undef $min;
        }
        else {
            push @range => $num;
        }
    }
    return @range;
}

As a first pass, it's awful, but I'm working on it!

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • /\b(\d+)( ((??{$++1})))+/$1-$+/g;s/ /, /g
  • Please don't try to make it match Test::Harness. The old Test::Harness format is clunky and yucky. I've been meaning to redo it for some time.

    Maybe you can come up with something beautiful that I can steal instead!

    --

    --
    xoa

    • Well, I've had a lot of trouble coming up with an exact match (and in any event, it can't match exactly because I have different information I present). However, so far I'm quite satisfied I've come up with something even clunkier and yuckier than Test::Harness. However, it works :)

      My thought is fix a couple of minor nits, get --exec nailed down, and release. If I do that, maybe my output will be so ugly I can get suggestions or even patches!