1#!/usr/bin/perl
2
3# Run tests in parallel.  This just allows you to check that your tests
4# are roughly capable of running in parallel.  It writes output to a
5# tree in /tmp.
6# From: Eric Wilhelm @ ewilhelm at cpan.org
7
8use warnings;
9use strict;
10
11use File::Basename ();
12use File::Path     ();
13use List::Util     ();
14
15my @tests = @ARGV;
16
17#@tests = List::Util::shuffle(@tests);
18
19use POSIX ();
20
21my %map;
22my $i = 0;
23
24my $jobs = 9;    # scalar(@tests); # if you like forkbombs
25my @running;
26
27while (@tests) {
28    if ( $jobs == @running ) {
29        my @list;
30        while ( my $pid = shift(@running) ) {
31            if ( waitpid( $pid, POSIX::WNOHANG() ) > 0 ) {
32                warn ' ' x 25 . "done $map{$pid}\n";
33                next;
34            }
35            push( @list, $pid );
36        }
37
38        #warn "running ", scalar(@list);
39        @running = @list;
40        next;
41    }
42    my $test = shift(@tests);
43    defined( my $pid = fork ) or die;
44    $i++;
45    if ($pid) {
46        push( @running, $pid );
47        $map{$pid} = $test;
48        print "$test\n";
49    }
50    else {
51        my $dest_base = '/tmp';
52        my $dest_dir  = File::Basename::dirname("$dest_base/$test");
53        unless ( -d $dest_dir ) {
54            File::Path::mkpath($dest_dir) or die;
55        }
56
57        $| = 1;
58        open( STDOUT, '>', "$dest_base/$test.out" ) or die;
59        open( STDERR, '>', "$dest_base/$test.err" ) or die;
60        exec( $^X, '-Ilib', $test );
61    }
62}
63
64my $v = 0;
65until ( $v == -1 ) {
66    $v = wait;
67    ( $v == -1 ) and last;
68    $?           and warn "$map{$v} ($v) no happy $?";
69}
70print "bye\n";
71
72# vim:ts=2:sw=2:et:sta
73