vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libtest-harness-perl/libtest-harness-perl-3.12/examples/bin/forked_tests.pl

   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
   8 use warnings;
   9 use strict;
  10
  11 use File::Basename ();
  12 use File::Path     ();
  13 use List::Util     ();
  14
  15 my @tests = @ARGV;
  16
  17 #@tests = List::Util::shuffle(@tests);
  18
  19 use POSIX ();
  20
  21 my %map;
  22 my $i = 0;
  23
  24 my $jobs = 9;    # scalar(@tests); # if you like forkbombs
  25 my @running;
  26
  27 while (@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
  64 my $v = 0;
  65 until ( $v == -1 ) {
  66     $v = wait;
  67     ( $v == -1 ) and last;
  68     $?           and warn "$map{$v} ($v) no happy $?";
  69 }
  70 print "bye\n";
  71
  72 # vim:ts=2:sw=2:et:sta