t/run.perl: fix for >128 tests

We need to explicitly close the write-end of the pipe in workers
to ensure they don't prevent each other from seeing EOF.

Also, make a note to keep using the pipe for now since
Linux <3.14 had broken read(2) semantics when file descriptions
are shared across threads/processes.

diff --git a/t/run.perl b/t/run.perl
index 96db3045a04f535eeed8413dda419ef4bc3f1547..d0b29e687158792ee0fac02a0e22cb3fcfc7b18d 100755 (executable)
--- a/t/run.perl
+++ b/t/run.perl
@@ -127,9 +127,10 @@ my $producer = $$;
 my $eof; # we stop respawning if true
 
 my $start_worker = sub {
-       my ($i, $j, $rd, $todo) = @_;
+       my ($j, $rd, $wr, $todo) = @_;
        my $pid = fork // DIE "fork: $!";
        if ($pid == 0) {
+               close $wr if $wr;
                $worker = $$;
                while (1) {
                        my $r = sysread($rd, my $buf, UINT_SIZE);
@@ -155,15 +156,16 @@ my $start_worker = sub {
 for (my $i = $repeat; $i != 0; $i--) {
        my @todo = $shuffle ? List::Util::shuffle(@tests) : @tests;
 
-       # single-producer, multi-consumer queue relying on POSIX semantics
+       # single-producer, multi-consumer queue relying on POSIX pipe semantics
+       # POSIX.1-2008 stipulates a regular file should work, but Linux <3.14
+       # had broken read(2) semantics according to the read(2) manpage
        pipe(my ($rd, $wr)) or DIE "pipe: $!";
 
        # fill the queue before forking so children can start earlier
        my $n = (_POSIX_PIPE_BUF / UINT_SIZE);
        if ($n >= $#todo) {
                print $wr join('', map { pack('I', $_) } (0..$#todo)) or DIE;
-               close $wr or die;
-               $wr = undef;
+               undef $wr;
        } else { # write what we can...
                $wr->autoflush(1);
                print $wr join('', map { pack('I', $_) } (0..$n)) or DIE;
@@ -186,22 +188,21 @@ for (my $i = $repeat; $i != 0; $i--) {
                        # skip_all can exit(0), respawn if needed:
                        if (!$eof) {
                                print $OLDERR "# respawning job[$j]\n";
-                               $start_worker->($i, $j, $rd, \@todo);
+                               $start_worker->($j, $rd, $wr, \@todo);
                        }
                }
        };
 
        # start the workers to consume the queue
        for (my $j = 0; $j < $jobs; $j++) {
-               $start_worker->($i, $j, $rd, \@todo);
+               $start_worker->($j, $rd, $wr, \@todo);
        }
-
        if ($wr) {
                local $SIG{CHLD} = $sigchld;
                # too many tests to fit in the pipe before starting workers,
                # send the rest now the workers are running
                print $wr join('', map { pack('I', $_) } ($n..$#todo)) or DIE;
-               close $wr or die;
+               undef $wr;
        }
 
        $sigchld->(0) while scalar(keys(%pids));