[7/10] is the centerpiece and gives a ~10% speedup for tests, which are still slow to me. Speedup or not, it's uncovered a bunch of subtle bugs over the past few days so I'm glad I worked on it. There's still some rare errors that come from looping "make check-run TEST_LEI_ERR_LOUD" which I'm still trying to figure out... Eric Wong (10): test_common: cleanup inbox objects after use lei: janky $PATH2CFG garbage collection test_common: TEST_LEI_ERR_LOUD does not hide path names lei add-external: do not initialize writable store lei_mirror: don't show success on failure t/*: drop unnecessary v1-specific index calls tests: "check-run" uses persistent lei daemon lei import: force store, improve test diagnostics t/cmd_ipc: workaround signal handling raciness t/lei: add more diagnostics for failures lib/PublicInbox/LEI.pm | 6 +++++ lib/PublicInbox/LeiExternal.pm | 2 -- lib/PublicInbox/LeiImport.pm | 6 ++--- lib/PublicInbox/LeiMirror.pm | 11 ++++++--- lib/PublicInbox/TestCommon.pm | 41 +++++++++++++++++++++++----------- t/cmd_ipc.t | 28 ++++++++++++++++------- t/inbox_idle.t | 2 -- t/lei-externals.t | 7 ++++-- t/lei-import-maildir.t | 13 +++++++---- t/lei-mark.t | 2 +- t/lei-mirror.t | 18 +++++++++++++++ t/lei-q-kw.t | 6 ++--- t/lei-q-thread.t | 15 +++++++------ t/nntpd.t | 4 ---- t/run.perl | 19 ++++++++++++++++ t/v2mda.t | 4 ---- t/watch_filter_rubylang.t | 7 ++---- 17 files changed, 130 insertions(+), 61 deletions(-)
This stops us from leaking some more file handles across test cases. --- lib/PublicInbox/TestCommon.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm index d4117b6c..e127970e 100644 --- a/lib/PublicInbox/TestCommon.pm +++ b/lib/PublicInbox/TestCommon.pm @@ -291,6 +291,7 @@ sub run_script ($;$$) { local $0 = join(' ', @$cmd); my $orig_io = _prepare_redirects($fhref); _run_sub($sub, $key, \@argv); + eval { PublicInbox::Inbox::cleanup_task() }; _undo_redirects($orig_io); select STDOUT; }
We need to rely on this to keep our config cache (and lei_store pipes) under control with tests each creating a new config and directory. --- lib/PublicInbox/LEI.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index e5211764..d534f1d0 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -705,6 +705,12 @@ sub _lei_cfg ($;$) { File::Spec->canonpath($cfg->{'leistore.dir'})) { $cfg->{-lei_store} = $sto; } + if (scalar(keys %PATH2CFG) > 5) { + # FIXME: use inotify/EVFILT_VNODE to detect unlinked configs + for my $k (keys %PATH2CFG) { + delete($PATH2CFG{$k}) unless -f $k + } + } $self->{cfg} = $PATH2CFG{$f} = $cfg; }
We hide paths by default to reduce noise, but we want noise with loud errors. --- lib/PublicInbox/TestCommon.pm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm index e127970e..ffff5902 100644 --- a/lib/PublicInbox/TestCommon.pm +++ b/lib/PublicInbox/TestCommon.pm @@ -11,6 +11,7 @@ use POSIX qw(dup2); use IO::Socket::INET; use File::Spec; our @EXPORT; +my $lei_loud = $ENV{TEST_LEI_ERR_LOUD}; BEGIN { @EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods run_script start_script key2sub xsys xsys_e xqx eml_load tick @@ -463,21 +464,24 @@ sub lei (@) { $lei_err =~ m!\bArgument .*? isn't numeric in !) { fail "lei_err=$lei_err"; } else { - state $loud = $ENV{TEST_LEI_ERR_LOUD}; - diag "lei_err=$lei_err" if $loud; + diag "lei_err=$lei_err" if $lei_loud; } } $res; }; sub lei_ok (@) { + state $PWD = $ENV{PWD} // Cwd::getcwd(); my $msg = ref($_[-1]) eq 'SCALAR' ? pop(@_) : undef; my $tmpdir = quotemeta(File::Spec->tmpdir); # filter out anything that looks like a path name for consistent logs my @msg = ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_; - for (@msg) { - s!\A([a-z0-9]+://)[^/]+/!$1\$HOST_PORT/! || - s!$tmpdir\b/(?:[^/]+/)?!\$TMPDIR/!; + if (!$lei_loud) { + for (@msg) { + s!\A([a-z0-9]+://)[^/]+/!$1\$HOST_PORT/!; + s!$tmpdir\b/(?:[^/]+/)?!\$TMPDIR/!g; + s!\Q$PWD\E\b!\$PWD!g; + } } ok(lei(@_), "lei @msg". ($msg ? " ($$msg)" : '')) or diag $lei_err; }
There's no need to create or write lei/store when adding an external, we just need to write to the config file. --- lib/PublicInbox/LeiExternal.pm | 2 -- t/lei-externals.t | 3 +-- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/lib/PublicInbox/LeiExternal.pm b/lib/PublicInbox/LeiExternal.pm index 56d6ef39..5e8dc71a 100644 --- a/lib/PublicInbox/LeiExternal.pm +++ b/lib/PublicInbox/LeiExternal.pm @@ -144,8 +144,6 @@ sub add_external_finish { sub lei_add_external { my ($self, $location) = @_; - my $sto = $self->_lei_store(1); - $sto->write_prepare($self); my $opt = $self->{opt}; my $mirror = $opt->{mirror} // do { my @fail; diff --git a/t/lei-externals.t b/t/lei-externals.t index 2045691f..afd90d19 100644 --- a/t/lei-externals.t +++ b/t/lei-externals.t @@ -93,8 +93,7 @@ test_lei(sub { \'added external'); is($lei_out.$lei_err, '', 'no output'); }); - ok(-s $config_file && -e $store_dir, - 'add-external created config + store'); + ok(-s $config_file, 'add-external created config'); my $lcfg = PublicInbox::Config->new($config_file); $cfg->each_inbox(sub { my ($ibx) = @_;
While we were exiting with a error code, showing a successful "# mirrored $URL" message is misleading and wrong. Don't show success until everything is complete and the config is written. --- lib/PublicInbox/LeiMirror.pm | 11 ++++++++--- t/lei-mirror.t | 18 ++++++++++++++++++ 2 files changed, 26 insertions(+), 3 deletions(-) diff --git a/lib/PublicInbox/LeiMirror.pm b/lib/PublicInbox/LeiMirror.pm index d68cd6c1..c83386c6 100644 --- a/lib/PublicInbox/LeiMirror.pm +++ b/lib/PublicInbox/LeiMirror.pm @@ -12,8 +12,14 @@ use PublicInbox::Spawn qw(popen_rd spawn); sub do_finish_mirror { # dwaitpid callback my ($arg, $pid) = @_; my ($mrr, $lei) = @$arg; - if ($? == 0 && unlink("$mrr->{dst}/mirror.done")) { + my $f = "$mrr->{dst}/mirror.done"; + if ($?) { + $lei->child_error($?); + } elsif (!unlink($f)) { + $lei->err("unlink($f): $!"); + } else { $lei->add_external_finish($mrr->{dst}); + $lei->qerr("# mirrored $mrr->{src} => $mrr->{dst}"); } $lei->dclose; } @@ -262,8 +268,7 @@ sub do_mirror { # via wq_io_do return start_clone_url($self) if $self->{src} =~ m!://!; die "TODO: cloning local directories not supported, yet"; }; - return $lei->fail($@) if $@; - $lei->qerr("# mirrored $self->{src} => $self->{dst}"); + $lei->fail($@) if $@; } sub start { diff --git a/t/lei-mirror.t b/t/lei-mirror.t index 9769f31b..6039e568 100644 --- a/t/lei-mirror.t +++ b/t/lei-mirror.t @@ -41,6 +41,24 @@ test_lei({ tmpdir => $tmpdir }, sub { ok(!-d "$t2-fail", 'destination not created on failure'); lei_ok('ls-external'); unlike($lei_out, qr!\Q$t2-fail\E!, 'not added to ls-external'); + + my %phail = ( + HTTPS => 'https://public-inbox.org/' . 'phail', + ONION => 'http://ou63pmih66umazou.onion/' . 'phail,' + ); + for my $t (qw(HTTPS ONION)) { + SKIP: { + my $k = "TEST_LEI_EXTERNAL_$t"; + $ENV{$k} or skip "$k unset", 1; + my $url = $phail{$t}; + my $dir = "phail-$t"; + ok(!lei(qw(add-external -Lmedium --mirror), + $url, $dir), '--mirror non-existent v2'); + is($? >> 8, 22, 'curl 404'); + ok(!-d $dir, 'directory not created'); + unlike($lei_err, qr/# mirrored/, 'no success message'); + } # SKIP + } # for }); ok($td->kill, 'killed -httpd');
Outside of mirrors, we can -init with indexlevel to avoid calling -index explicitly. --- t/inbox_idle.t | 2 -- t/nntpd.t | 4 ---- t/v2mda.t | 4 ---- t/watch_filter_rubylang.t | 7 ++----- 4 files changed, 2 insertions(+), 15 deletions(-) diff --git a/t/inbox_idle.t b/t/inbox_idle.t index c9df73a1..51379764 100644 --- a/t/inbox_idle.t +++ b/t/inbox_idle.t @@ -42,13 +42,11 @@ EOF my $im = $ibx->importer(0); ok($im->add(eml_load('t/utf8.eml')), "$V added"); $im->done; - PublicInbox::SearchIdx->new($ibx)->index_sync if $V == 1; $ii->event_step; is(scalar @{$obj->{called}}, 1, 'called on unlock'); $pi_cfg->each_inbox(sub { shift->unsubscribe_unlock($ident) }); ok($im->add(eml_load('t/data/0001.patch')), "$V added #2"); $im->done; - PublicInbox::SearchIdx->new($ibx)->index_sync if $V == 1; $ii->event_step; is(scalar @{$obj->{called}}, 1, 'not called when unsubbed'); $ii->close; diff --git a/t/nntpd.t b/t/nntpd.t index ce4d7cf9..67205fe5 100644 --- a/t/nntpd.t +++ b/t/nntpd.t @@ -253,10 +253,6 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 my $im = $ibx->importer(0); $im->add($for_leafnode); $im->done; - if ($version == 1) { - ok(run_script(['-index', $ibx->{inboxdir}]), - 'indexed v1'); - } my $hdr = $n->head("<$long_hdr>"); my $expect = qr/\AMessage-ID: /i . qr/\Q<$long_hdr>\E/; ok(scalar(grep(/$expect/, @$hdr)), 'Message-ID not folded'); diff --git a/t/v2mda.t b/t/v2mda.t index 38aea0c1..3dfc569e 100644 --- a/t/v2mda.t +++ b/t/v2mda.t @@ -46,10 +46,6 @@ local $ENV{ORIGINAL_RECIPIENT} = 'test@example.com'; ok(run_script(['-mda'], undef, $rdr), 'mda delivered a message'); $ibx = PublicInbox::Inbox->new($ibx); - -if ($V == 1) { - ok(run_script([ '-index', "$tmpdir/inbox" ]), 'v1 indexed'); -} my $msgs = $ibx->over->recent; is(scalar(@$msgs), 1, 'only got one message'); my $eml = $ibx->smsg_eml($msgs->[0]); diff --git a/t/watch_filter_rubylang.t b/t/watch_filter_rubylang.t index 5deb2082..004e794e 100644 --- a/t/watch_filter_rubylang.t +++ b/t/watch_filter_rubylang.t @@ -30,12 +30,9 @@ for my $v (@v) { my $maildir = "$tmpdir/md-$v"; my $spamdir = "$tmpdir/spam-$v"; my $addr = "test-$v\@example.com"; - my @cmd = ('-init', "-$v", $v, $inboxdir, + my @cmd = ('-init', '-Lfull', "-$v", $v, $inboxdir, "http://example.com/$v", $addr); - ok(run_script(\@cmd), 'public-inbox init OK'); - if ($v eq 'V1') { - ok(run_script(['-index', $inboxdir]), 'v1 indexed'); - } + ok(run_script(\@cmd), 'public-inbox init'); PublicInbox::Emergency->new($spamdir); for my $i (1..15) {
We'll use a lei-daemon if it's already running and TEST_LEI_DAEMON_PERSIST_DIR is set, but we can also start one and manage it from t/run.perl This drops "make check-run TEST_LEI_DAEMON_ONLY=1" time by ~10% for me. --- lib/PublicInbox/TestCommon.pm | 22 +++++++++++++++------- t/lei-externals.t | 4 ++++ t/run.perl | 19 +++++++++++++++++++ 3 files changed, 38 insertions(+), 7 deletions(-) diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm index ffff5902..ca165a04 100644 --- a/lib/PublicInbox/TestCommon.pm +++ b/lib/PublicInbox/TestCommon.pm @@ -515,22 +515,30 @@ EOM my ($daemon_pid, $for_destroy, $daemon_xrd); my $tmpdir = $test_opt->{tmpdir}; ($tmpdir, $for_destroy) = tmpdir unless $tmpdir; + state $persist_xrd = $ENV{TEST_LEI_DAEMON_PERSIST_DIR}; SKIP: { skip 'TEST_LEI_ONESHOT set', 1 if $ENV{TEST_LEI_ONESHOT}; my $home = "$tmpdir/lei-daemon"; mkdir($home, 0700) or BAIL_OUT "mkdir: $!"; local $ENV{HOME} = $home; - $daemon_xrd = "$home/xdg_run"; - mkdir($daemon_xrd, 0700) or BAIL_OUT "mkdir: $!"; + my $persist; + if ($persist_xrd && !$test_opt->{daemon_only}) { + $persist = $daemon_xrd = $persist_xrd; + } else { + $daemon_xrd = "$home/xdg_run"; + mkdir($daemon_xrd, 0700) or BAIL_OUT "mkdir: $!"; + } local $ENV{XDG_RUNTIME_DIR} = $daemon_xrd; $cb->(); - lei_ok(qw(daemon-pid), \"daemon-pid after $t"); - chomp($daemon_pid = $lei_out); - if ($daemon_pid) { + unless ($persist) { + lei_ok(qw(daemon-pid), \"daemon-pid after $t"); + chomp($daemon_pid = $lei_out); + if (!$daemon_pid) { + fail("daemon not running after $t"); + skip 'daemon died unexpectedly', 2; + } ok(kill(0, $daemon_pid), "daemon running after $t"); lei_ok(qw(daemon-kill), \"daemon-kill after $t"); - } else { - fail("daemon not running after $t"); } }; # SKIP for lei_daemon unless ($test_opt->{daemon_only}) { diff --git a/t/lei-externals.t b/t/lei-externals.t index afd90d19..488bf5ad 100644 --- a/t/lei-externals.t +++ b/t/lei-externals.t @@ -57,6 +57,8 @@ SKIP: { chomp(my $pid_after = $lei_out); is($pid_after, $pid_before, 'pid unchanged') or skip 'daemon died', 1; + skip 'not killing persistent lei-daemon', 2 if + $ENV{TEST_LEI_DAEMON_PERSIST_DIR}; lei_ok 'daemon-kill'; my $alive = 1; for (1..100) { @@ -262,6 +264,8 @@ test_lei(sub { } { + skip 'TEST_LEI_DAEMON_PERSIST_DIR in use', 1 if + $ENV{TEST_LEI_DAEMON_PERSIST_DIR}; opendir my $dh, '.' or BAIL_OUT "opendir(.) $!"; my $od = PublicInbox::OnDestroy->new($$, sub { chdir $dh or BAIL_OUT "chdir: $!" diff --git a/t/run.perl b/t/run.perl index e8512e18..1fb1c5f0 100755 --- a/t/run.perl +++ b/t/run.perl @@ -14,6 +14,7 @@ use strict; use v5.10.1; use IO::Handle; # ->autoflush use PublicInbox::TestCommon; +use PublicInbox::Spawn; use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); use Errno qw(EINTR); use Fcntl qw(:seek); @@ -40,6 +41,20 @@ $OLDERR->autoflush(1); key2sub($_) for @tests; # precache +my ($for_destroy, $lei_env, $lei_daemon_pid, $owner_pid); +if (!$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: $!"; + $owner_pid = $$; +} + if ($shuffle) { require List::Util; } elsif (open(my $prove_state, '<', '.prove') && eval { require YAML::XS }) { @@ -209,3 +224,7 @@ 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 }; + run_script([qw(lei daemon-kill)], $lei_env, $opt); +}
"lei import" should never be without a {sto}, and *_done should not be called multiple times, so ensure we can fail if it's missing. Update some existing tests to complain loudly by introducing a handy "xbail" function which wraps "explain" and BAIL_OUT. BAIL_OUT was painful to type and concatenating the result of "explain" doesn't work as I thought it would since "explain" always returns an array, and BAIL_OUT only accepts a single scalar arg (unlike "die"). --- lib/PublicInbox/LeiImport.pm | 6 +++--- lib/PublicInbox/TestCommon.pm | 4 +++- t/lei-mark.t | 2 +- t/lei-q-kw.t | 6 +++--- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/lib/PublicInbox/LeiImport.pm b/lib/PublicInbox/LeiImport.pm index 9da6b7f9..7c5b7d09 100644 --- a/lib/PublicInbox/LeiImport.pm +++ b/lib/PublicInbox/LeiImport.pm @@ -39,14 +39,14 @@ sub import_done_wait { # dwaitpid callback my ($arg, $pid) = @_; my ($imp, $lei) = @$arg; $lei->child_error($?, 'non-fatal errors during import') if $?; - my $sto = delete $lei->{sto}; - my $wait = $sto->ipc_do('done') if $sto; # PublicInbox::LeiStore::done + my $sto = delete $lei->{sto} // return $lei->fail('BUG: {sto} gone'); + my $wait = $sto->ipc_do('done'); # PublicInbox::LeiStore::done $lei->dclose; } sub import_done { # EOF callback for main daemon my ($lei) = @_; - my $imp = delete $lei->{imp} or return; + my $imp = delete $lei->{imp} // return $lei->fail('BUG: {imp} gone'); $imp->wq_wait_old(\&import_done_wait, $lei); } diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm index ca165a04..72617a78 100644 --- a/lib/PublicInbox/TestCommon.pm +++ b/lib/PublicInbox/TestCommon.pm @@ -17,7 +17,7 @@ BEGIN { run_script start_script key2sub xsys xsys_e xqx eml_load tick have_xapian_compact json_utf8 setup_public_inboxes create_inbox tcp_host_port test_lei lei lei_ok $lei_out $lei_err $lei_opt - test_httpd); + test_httpd xbail); require Test::More; my @methods = grep(!/\W/, @Test::More::EXPORT); eval(join('', map { "*$_=\\&Test::More::$_;" } @methods)); @@ -25,6 +25,8 @@ BEGIN { push @EXPORT, @methods; } +sub xbail (@) { BAIL_OUT join(' ', map { ref ? (explain($_)) : ($_) } @_) } + sub eml_load ($) { my ($path, $cb) = @_; open(my $fh, '<', $path) or die "open $path: $!"; diff --git a/t/lei-mark.t b/t/lei-mark.t index ddf5634c..76995589 100644 --- a/t/lei-mark.t +++ b/t/lei-mark.t @@ -30,7 +30,7 @@ test_lei(sub { ok(-s $mb, 'wrote mbox result'); lei_ok(qw(q m:testmessage@example.com -o), $md); my @fn = glob("$md/cur/*"); - scalar(@fn) == 1 or BAIL_OUT 'no mail '.explain(\@fn); + scalar(@fn) == 1 or xbail $lei_err, 'no mail', \@fn; rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; $check_kw->(['flagged'], msg => 'after bad request'); lei_ok(qw(mark -F eml t/utf8.eml -kw:flagged)); diff --git a/t/lei-q-kw.t b/t/lei-q-kw.t index 4db27363..c17411fb 100644 --- a/t/lei-q-kw.t +++ b/t/lei-q-kw.t @@ -21,7 +21,7 @@ lei_ok(qw(import -F eml t/plack-qp.eml)); my $o = "$ENV{HOME}/dst"; lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com)); my @fn = glob("$o/cur/*:2,"); -scalar(@fn) == 1 or BAIL_OUT "wrote multiple or zero files: ".explain(\@fn); +scalar(@fn) == 1 or xbail $lei_err, 'wrote multiple or zero files:', \@fn; rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; lei_ok(qw(q -o), "maildir:$o", qw(m:bogus-noresults@example.com)); @@ -124,7 +124,7 @@ lei_ok(qw(q -o), $o, "m:$m", @inc); # emulate MUA marking a Maildir message as read: @fn = glob("$o/cur/*"); -scalar(@fn) == 1 or BAIL_OUT "wrote multiple or zero files: ".explain(\@fn); +scalar(@fn) == 1 or xbail $lei_err, 'wrote multiple or zero files:', \@fn; rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; lei_ok(qw(q -o), $o, 'bogus', \'clobber output dir to import keywords'); @@ -178,7 +178,7 @@ $m = 'multipart@example.com'; $o = "$ENV{HOME}/fuzz"; lei_ok('q', '-o', $o, "m:$m", @inc); @fn = glob("$o/cur/*"); -scalar(@fn) == 1 or BAIL_OUT "wrote multiple or zero files: ".explain(\@fn); +scalar(@fn) == 1 or xbail $lei_err, "wrote multiple or zero files", \@fn; rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; lei_ok('q', '-o', $o, "m:$m"); is_deeply([glob("$o/cur/*")], [], 'clobbered output results');
Perl can't check for interrupts when inside a blocking syscall, as there's no self-pipe mechanism inside Perl itself. So fork a child and have it repeated kill(2) instead of relying on alarm(3). --- t/cmd_ipc.t | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/t/cmd_ipc.t b/t/cmd_ipc.t index 84f8fb4d..c5e715a1 100644 --- a/t/cmd_ipc.t +++ b/t/cmd_ipc.t @@ -10,7 +10,7 @@ pipe(my ($r, $w)) or BAIL_OUT; my ($send, $recv); require_ok 'PublicInbox::Spawn'; my $SOCK_SEQPACKET = eval { Socket::SOCK_SEQPACKET() } // undef; -use Time::HiRes qw(alarm); +use Time::HiRes qw(usleep); my $do_test = sub { SKIP: { my ($type, $flag, $desc) = @_; @@ -53,13 +53,25 @@ my $do_test = sub { SKIP: { is_deeply(\@fds, [ undef ], "EAGAIN $desc"); $s2->blocking(1); - my $alrm = 0; - local $SIG{ALRM} = sub { $alrm++ }; - alarm(0.001); - @fds = $recv->($s2, $buf, length($src) + 1); - ok($!{EINTR}, "EINTR set by ($desc)"); - is_deeply(\@fds, [ undef ], "EINTR $desc"); - is($alrm, 1, 'SIGALRM hit'); + if ($ENV{TEST_ALRM}) { + my $alrm = 0; + local $SIG{ALRM} = sub { $alrm++ }; + my $tgt = $$; + my $pid = fork // xbail "fork: $!"; + if ($pid == 0) { + # need to loop since Perl signals are racy + # (the interpreter doesn't self-pipe) + while (usleep(1000)) { + kill 'ALRM', $tgt; + } + } + @fds = $recv->($s2, $buf, length($src) + 1); + ok($!{EINTR}, "EINTR set by ($desc)"); + kill('KILL', $pid); + waitpid($pid, 0); + is_deeply(\@fds, [ undef ], "EINTR $desc"); + ok($alrm, 'SIGALRM hit'); + } close $s1; @fds = $recv->($s2, $buf, length($src) + 1);
This seems to error out while looping the test suite and I'm not 100% sure why. --- t/lei-import-maildir.t | 13 +++++++++---- t/lei-q-thread.t | 15 ++++++++------- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/t/lei-import-maildir.t b/t/lei-import-maildir.t index bd89677a..6706b014 100644 --- a/t/lei-import-maildir.t +++ b/t/lei-import-maildir.t @@ -11,17 +11,20 @@ test_lei(sub { symlink(abs_path('t/data/0001.patch'), "$md/cur/x:2,S") or BAIL_OUT "symlink $md $!"; lei_ok(qw(import), $md, \'import Maildir'); + my $imp_err = $lei_err; lei_ok(qw(q s:boolean)); my $res = json_utf8->decode($lei_out); - like($res->[0]->{'s'}, qr/use boolean/, 'got expected result'); + like($res->[0]->{'s'}, qr/use boolean/, 'got expected result') + or diag explain($imp_err, $res); is_deeply($res->[0]->{kw}, ['seen'], 'keyword set'); is($res->[1], undef, 'only got one result'); lei_ok(qw(import), $md, \'import Maildir again'); + $imp_err = $lei_err; lei_ok(qw(q -d none s:boolean), \'lei q w/o dedupe'); my $r2 = json_utf8->decode($lei_out); - is_deeply($r2, $res, 'idempotent import'); - + is_deeply($r2, $res, 'idempotent import') + or diag explain($imp_err, $res); rename("$md/cur/x:2,S", "$md/cur/x:2,SR") or BAIL_OUT "rename: $!"; lei_ok('import', "maildir:$md", \'import Maildir after +answered'); lei_ok(qw(q -d none s:boolean), \'lei q after +answered'); @@ -33,8 +36,10 @@ test_lei(sub { symlink(abs_path('t/utf8.eml'), "$md/cur/u:2,ST") or BAIL_OUT "symlink $md $!"; lei_ok('import', "maildir:$md", \'import Maildir w/ trashed message'); + $imp_err = $lei_err; lei_ok(qw(q -d none m:testmessage@example.com)); $res = json_utf8->decode($lei_out); - is_deeply($res, [ undef ], 'trashed message not imported'); + is_deeply($res, [ undef ], 'trashed message not imported') + or diag explain($imp_err, $res); }); done_testing; diff --git a/t/lei-q-thread.t b/t/lei-q-thread.t index c999d12b..26d06eec 100644 --- a/t/lei-q-thread.t +++ b/t/lei-q-thread.t @@ -13,7 +13,8 @@ test_lei(sub { lei_ok qw(q -t m:testmessage@example.com); my $res = json_utf8->decode($lei_out); - is_deeply($res->[0]->{kw}, [ 'seen' ], 'q -t sets keywords'); + is_deeply($res->[0]->{kw}, [ 'seen' ], 'q -t sets keywords') or + diag explain($res); $eml = eml_load('t/utf8.eml'); $eml->header_set('References', $eml->header('Message-ID')); @@ -28,9 +29,9 @@ test_lei(sub { pop @$res; my %m = map { $_->{'m'} => $_ } @$res; is_deeply($m{'testmessage@example.com'}->{kw}, ['seen'], - 'flag set in direct hit'); - 'TODO' or is_deeply($m{'a-reply@miss'}->{kw}, ['draft'], - 'flag set in thread hit'); + 'flag set in direct hit') or diag explain($res); + is_deeply($m{'a-reply@miss'}->{kw}, ['draft'], + 'flag set in thread hit') or diag explain($res); lei_ok qw(q -t -t m:testmessage@example.com); $res = json_utf8->decode($lei_out); @@ -38,9 +39,9 @@ test_lei(sub { pop @$res; %m = map { $_->{'m'} => $_ } @$res; is_deeply($m{'testmessage@example.com'}->{kw}, ['flagged', 'seen'], - 'flagged set in direct hit'); - 'TODO' or is_deeply($m{'testmessage@example.com'}->{kw}, ['draft'], - 'flagged set in direct hit'); + 'flagged set in direct hit') or diag explain($res); + is_deeply($m{'a-reply@miss'}->{kw}, ['draft'], + 'set in thread hit') or diag explain($res); lei_ok qw(q -tt m:testmessage@example.com --only), "$ro_home/t2"; $res = json_utf8->decode($lei_out); is_deeply($res->[0]->{kw}, [ qw(flagged seen) ],