X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Frun.perl;h=cf80a8a17ecedc54304d5280744e5b5d857e4209;hb=4eee5af6011cc8cdefb66c9729952c7eff5c0b0b;hp=1c7bcfc34db6fc3a24f28e468ee3d0d2f6f0827c;hpb=670e37954c1d91fb096dfc8604c2d6ab81d03e08;p=public-inbox.git diff --git a/t/run.perl b/t/run.perl index 1c7bcfc3..cf80a8a1 100755 --- a/t/run.perl +++ b/t/run.perl @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# Copyright (C) 2019-2020 all contributors +# Copyright (C) 2019-2021 all contributors # License: AGPL-3.0+ # # Parallel test runner which preloads code and reuses worker processes @@ -14,11 +14,12 @@ use strict; use v5.10.1; use IO::Handle; # ->autoflush use PublicInbox::TestCommon; -use Cwd qw(getcwd); +use PublicInbox::Spawn; use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); use Errno qw(EINTR); use Fcntl qw(:seek); -use POSIX qw(_POSIX_PIPE_BUF WNOHANG); +use POSIX qw(WNOHANG); +use File::Temp (); my $jobs = 1; my $repeat = 1; $| = 1; @@ -33,14 +34,49 @@ 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); $OLDERR->autoflush(1); +my ($run_log, $tmp_rl); +my $rl = $ENV{TEST_RUN_LOG}; +unless ($rl) { + $tmp_rl = File::Temp->new(CLEANUP => 1); + $rl = $tmp_rl->filename; +} +open $run_log, '+>>', $rl or die "open $rl: $!"; +$run_log->autoflush(1); # one reader, many writers + key2sub($_) for @tests; # precache +my ($for_destroy, $lei_env, $lei_daemon_pid, $owner_pid); + +# TEST_LEI_DAEMON_PERSIST is currently broken. I get ECONNRESET from +# lei even with high kern.ipc.soacceptqueue=1073741823 or SOMAXCONN, not +# sure why. Also, testing our internal inotify usage is unreliable +# because lei-daemon uses a single inotify FD for all clients. +if ($ENV{TEST_LEI_DAEMON_PERSIST} && !$ENV{TEST_LEI_DAEMON_PERSIST_DIR} && + (PublicInbox::Spawn->can('recv_cmd4') || + eval { require Socket::MsgHdr })) { + $lei_env = {}; + ($lei_env->{XDG_RUNTIME_DIR}, $for_destroy) = tmpdir; + $ENV{TEST_LEI_DAEMON_PERSIST_DIR} = $lei_env->{XDG_RUNTIME_DIR}; + run_script([qw(lei daemon-pid)], $lei_env, { 1 => \$lei_daemon_pid }); + chomp $lei_daemon_pid; + $lei_daemon_pid =~ /\A[0-9]+\z/ or die "no daemon pid: $lei_daemon_pid"; + kill(0, $lei_daemon_pid) or die "kill $lei_daemon_pid: $!"; + if (my $t = $ENV{GNU_TAIL}) { + system("$t --pid=$lei_daemon_pid -F " . + "$lei_env->{XDG_RUNTIME_DIR}/lei/errors.log >&2 &"); + } + if (my $strace_cmd = $ENV{STRACE_CMD}) { + system("$strace_cmd -p $lei_daemon_pid &"); + } + $owner_pid = $$; +} + if ($shuffle) { require List::Util; } elsif (open(my $prove_state, '<', '.prove') && eval { require YAML::XS }) { @@ -64,14 +100,15 @@ 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/; my $skip = ''; if (open my $fh, '<', $log) { my @not_ok = grep(!/^(?:ok |[ \t]*#)/ms, <$fh>); - pop @not_ok if $not_ok[-1] =~ /^[0-9]+\.\.[0-9]+$/; + my $last = $not_ok[-1] // ''; + pop @not_ok if $last =~ /^[0-9]+\.\.[0-9]+$/; my $pfx = "# $log: "; print $OLDERR map { $pfx.$_ } @not_ok; seek($fh, 0, SEEK_SET) or die "seek: $!"; @@ -98,6 +135,7 @@ END { test_status() if (defined($worker_test) && $worker == $$) } sub run_test ($) { my ($test) = @_; + syswrite($run_log, "$$ $test\n"); my $log_fh; if ($log_suffix ne '') { my $log = $test; @@ -126,9 +164,11 @@ 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; + $SIG{USR1} = undef; # undo parent $SIG{USR1} $worker = $$; while (1) { my $r = sysread($rd, my $buf, UINT_SIZE); @@ -143,7 +183,10 @@ my $start_worker = sub { $tb->reset; } kill 'USR1', $producer if !$eof; # sets $eof in $producer - DIE join('', map { "E: $_\n" } @err) if @err; + if (@err) { # write to run_log for $sigchld handler + syswrite($run_log, "$$ @err\n"); + DIE join('', map { "E: $_\n" } @err); + } exit(0); } else { $pids{$pid} = $j; @@ -154,15 +197,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); + 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; @@ -181,26 +225,30 @@ for (my $i = $repeat; $i != 0; $i--) { push @err, "reaped unknown $pid ($?)"; next; } - push @err, "job[$j] ($?)" if $?; + if ($?) { + seek($run_log, 0, SEEK_SET); + chomp(my @t = grep(/^$pid /, <$run_log>)); + $t[0] //= "$pid unknown"; + push @err, "job[$j] ($?) PID=$t[-1]"; + } # 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)); @@ -208,3 +256,10 @@ for (my $i = $repeat; $i != 0; $i--) { } print $OLDOUT "1..".($repeat * scalar(@tests))."\n" if $repeat >= 0; +if ($lei_env && $$ == $owner_pid) { + my $opt = { 1 => $OLDOUT, 2 => $OLDERR }; + my $cur_daemon_pid; + run_script([qw(lei daemon-pid)], $lei_env, { 1 => \$cur_daemon_pid }); + run_script([qw(lei daemon-kill)], $lei_env, $opt); + DIE "lei daemon restarted\n" if $cur_daemon_pid != $lei_daemon_pid; +}