t/run.perl: drop Cwd dependency

[public-inbox.git] / t / run.perl

diff --git a/t/run.perl b/t/run.perl
index b7cb988be3e9b1f123ed484d0fc2ddc0b8e1e128..e8512e183acc84cceab436b223ca947f209e1ee2 100755 (executable)
--- a/t/run.perl
+++ b/t/run.perl
@@ -14,7 +14,6 @@ use strict;
 use v5.10.1;
 use IO::Handle; # ->autoflush
 use PublicInbox::TestCommon;
-use Cwd qw(getcwd);
 use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev);
 use Errno qw(EINTR);
 use Fcntl qw(:seek);
@@ -33,7 +32,7 @@ if (($ENV{TEST_RUN_MODE} // 2) == 0) {
        die "$0 is not compatible with TEST_RUN_MODE=0\n";
 }
 my @tests = scalar(@ARGV) ? @ARGV : glob('t/*.t');
-my $cwd = getcwd();
+open my $cwd_fh, '<', '.' or die "open .: $!";
 open my $OLDOUT, '>&STDOUT' or die "dup STDOUT: $!";
 open my $OLDERR, '>&STDERR' or die "dup STDERR: $!";
 $OLDOUT->autoflush(1);
@@ -64,7 +63,7 @@ our ($worker, $worker_test);
 sub test_status () {
        $? = 255 if $? == 0 && !$tb->is_passing;
        my $status = $? ? 'not ok' : 'ok';
-       chdir($cwd) or DIE "chdir($cwd): $!";
+       chdir($cwd_fh) or DIE "fchdir: $!";
        if ($log_suffix ne '') {
                my $log = $worker_test;
                $log =~ s/\.t\z/$log_suffix/;
@@ -127,9 +126,10 @@ my $producer = $$;
 my $eof; # we stop respawning if true
 
 my $start_worker = sub {
-       my ($i, $j, $rd, $todo) = @_;
-       defined(my $pid = fork) or DIE "fork: $!";
+       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 +155,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 +187,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));