Revision control

++ #!/usr/bin/env perl
++ use 5.010;
++ use strict;
++ use warnings;
++
++ =head1 NAME
++
++ 16-testrunner-capture-logs-race.t - test for one specific race condition
++
++ =cut
++
++ use English qw( -no_match_vars );
++ use File::Temp qw( tempdir );
++ use FindBin;
++ use Getopt::Long;
++ use Readonly;
++ use Test::More;
++
++ Readonly my $WINDOWS => ($OSNAME =~ m{mswin32}i);
++
++ # Directory containing some helper scripts
++ # Testrunner script
++ Readonly my @TESTRUNNER => (
++ $EXECUTABLE_NAME,
++ "$FindBin::Bin/../testrunner.pl",
++ );
++
++ # Like system(), but returns the pid and runs in the background
++ sub spawn
++ {
++ my (@cmd) = @_;
++
++ if ($WINDOWS) {
++ # avoid fork() on Windows - see 'perldoc perlport'
++ return system(1, @cmd);
++ }
++
++ my $pid = fork();
++ if ($pid == 0) {
++ exec( @cmd );
++ die "exec: $!";
++ } elsif ($pid < 0) {
++ die "fork: $!"
++ }
++
++ return $pid
++ }
++
++ # main entry point
++ sub run
++ {
++ my $debug;
++
++ GetOptions(
++ 'debug' => \$debug,
++ ) || die;
++
++ my $tempdir = tempdir( 'qtqa-test-capture-logs.XXXXXX', TMPDIR => 1, CLEANUP => !$debug );
++ if ($debug) {
++ diag( "Using $tempdir as temporary directory" );
++ }
++
++ # check precondition
++ my @globbed = glob( "$tempdir/*" );
++ ok( @globbed == 0, "$tempdir is empty" )
++ || diag "globbed: @globbed";
++
++ # The test is: if we run multiple testrunners in parallel with --capture-logs, do they all
++ # get unique output files or do some of them clobber each other?
++ # Note: this is also testing concurrent creation of the "logdir" directory.
++ my $MAX = 50;
++ my @cmd = (@TESTRUNNER, '--capture-logs', "$tempdir/logdir", '--', $EXECUTABLE_NAME, '--version');
++ my @pids = map { spawn(@cmd) } (1..$MAX);
++ while (my $next = shift @pids) {
++ if (waitpid( $next, 0 ) != $next) {
++ die "waitpid $next: $!";
++ }
++ }
++
++ # There should now be exactly $MAX files in the log directory, one per process.
++ @globbed = glob( "$tempdir/logdir/*" );
++ ok( @globbed == $MAX, 'one log file per process' )
++ || diag "globbed: @globbed";
++
++ done_testing( );
++
++ return;
++ }
++
++ run if (!caller);
++ 1;