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