outputtest.pl

#!/usr/bin/perl;
use strict;
use warnings;

use Test::More;

my $time = 60;

if ( @ARGV ) {
    writer();
}
else {
    harness();
}

sub writer {
    my @pids;
    my $char = { 1 => 'A', 2 => 'B', 3 => 'C', 4 => 'D' };
    for my $num (1 .. 4) {
        my $pid = fork();
        push @pids => $pid;
        next if $pid;
        while ( 1 ) {
            ok( 1, ( $char->{ $num } x 100));
        }
    }
    waitpid( $_, 0 ) for @pids;
}

sub harness {
    open( my $writer, "perl $0 1|" ) || die( $! );
    sleep 1;
    my $good = 0;
    my $bad = 0;
    local $SIG{ALRM} = sub {
        print "Good: $good\nBad: $bad\n";
        exit;
    };
    alarm( $time );
    while ( 1 ) {
        my $line = <$writer>;
        chomp( $line );
        if ( $line =~ m/^ok \d+ - ([A-D]){100}$/ ) {
            $good++;
        }
        else {
            $bad++;
            print STDERR "Bad\n";
        }
    }
}