Server IP : 184.154.167.98 / Your IP : 18.220.49.32 Web Server : Apache System : Linux pink.dnsnetservice.com 4.18.0-553.22.1.lve.1.el8.x86_64 #1 SMP Tue Oct 8 15:52:54 UTC 2024 x86_64 User : puertode ( 1767) PHP Version : 8.2.26 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/share/doc/perl-Test-Harness/examples/bin/ |
Upload File : |
#!/usr/bin/perl # Run tests in parallel. This just allows you to check that your tests # are roughly capable of running in parallel. It writes output to a # tree in /tmp. # From: Eric Wilhelm @ ewilhelm at cpan.org use warnings; use strict; use File::Basename (); use File::Path (); use List::Util (); my @tests = @ARGV; #@tests = List::Util::shuffle(@tests); use POSIX (); my %map; my $i = 0; my $jobs = 9; # scalar(@tests); # if you like forkbombs my @running; while (@tests) { if ( $jobs == @running ) { my @list; while ( my $pid = shift(@running) ) { if ( waitpid( $pid, POSIX::WNOHANG() ) > 0 ) { warn ' ' x 25 . "done $map{$pid}\n"; next; } push( @list, $pid ); } #warn "running ", scalar(@list); @running = @list; next; } my $test = shift(@tests); defined( my $pid = fork ) or die; $i++; if ($pid) { push( @running, $pid ); $map{$pid} = $test; print "$test\n"; } else { my $dest_base = '/tmp'; my $dest_dir = File::Basename::dirname("$dest_base/$test"); unless ( -d $dest_dir ) { File::Path::mkpath($dest_dir) or die; } $| = 1; open( STDOUT, '>', "$dest_base/$test.out" ) or die; open( STDERR, '>', "$dest_base/$test.err" ) or die; exec( $^X, '-Ilib', $test ); } } my $v = 0; until ( $v == -1 ) { $v = wait; ( $v == -1 ) and last; $? and warn "$map{$v} ($v) no happy $?"; } print "bye\n"; # vim:ts=2:sw=2:et:sta