Makefile: add `check-debris' target

This non-parallelized target is useful for noticing core dumps
and preventing them from being clobbered as we run the test
suite.  It will also notice leftover temporary files and
directories.

This make target was used on OpenBSD 7.3 to develop at least two
recent fixes:

e281363ba937 (lei: ensure we run DESTROY|END at daemon exit w/ kqueue)
759885e60e59 (lei: ensure --stdin sets %ENV and $current_lei)

I considered using a per-test TMPDIR for this to enable
parallelization, but on-filesystem UNIX sockets won't work
with excessively long path names.

diff --git a/MANIFEST b/MANIFEST
index 21f718ec09b6f279579fec1d2ffc0ff509463b98..2fe5dd173b8e10999954f28e815db3dec77fa605 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -620,6 +620,7 @@ t/x-unknown-alpine.eml
 t/xap_helper.t
 t/xcpdb-reshard.t
 version-gen.perl
+xt/check-debris.t
 xt/cmp-msgstr.t
 xt/create-many-inboxes.t
 xt/eml_check_limits.t

diff --git a/Makefile.PL b/Makefile.PL
index a04a3b753aa3a20aedefcd9b6036e0fad79c8207..5b7914dc50cc9863a3345de0a4e53029033a4077 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -235,12 +235,14 @@ check-each :: pure_all
        \$(EATMYDATA) \$(PROVE) --state=save -bvw -j\$(N)
        -@\$(check_manifest)
 
-# lightly-tested way to run tests, relies "--state=save" in check-each
-# for best performance
+# this relies "--state=save" in check-each for best performance
 check-run :: pure_all check-man
        \$(EATMYDATA) \$(PROVE) -bvw t/run.perl :: -j\$(N)
        -@\$(check_manifest)
 
+check-debris :: pure_all
+       PERL5LIB="\$\$PWD"/blib/lib \$(PROVE) -bvw xt/\$@.t
+
 check :: check-each
 
 lib/PublicInbox/UserContent.pm :: contrib/css/216dark.css

diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 4c819a4ffc01567d76a3afba52fcf6ef86ea5090..ae67a0ae6b92cb75f941f188ecccd69c52b13733 100644 (file)
--- 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;
 use Scalar::Util qw(isvstring);
+use Carp ();
 our @EXPORT;
 my $lei_loud = $ENV{TEST_LEI_ERR_LOUD};
 my $tail_cmd = $ENV{TAIL};
@@ -25,7 +26,7 @@ BEGIN {
                create_coderepo no_scm_rights
                tcp_host_port test_lei lei lei_ok $lei_out $lei_err $lei_opt
                test_httpd xbail require_cmd is_xdeeply tail_f
-               ignore_inline_c_missing no_pollerfd);
+               ignore_inline_c_missing no_pollerfd no_coredump);
        require Test::More;
        my @methods = grep(!/\W/, @Test::More::EXPORT);
        eval(join('', map { "*$_=\\&Test::More::$_;" } @methods));
@@ -298,8 +299,31 @@ sub _run_sub ($$$) {
        }
 }
 
+sub no_coredump (@) {
+       my @dirs = @_;
+       my $cwdfh;
+       if (@dirs) { opendir($cwdfh, '.') or die "opendir(.): $!" }
+       my @found;
+       for (@dirs, '.') {
+               chdir $_;
+               my @cores = glob('core.* *.core');
+               push @cores, 'core' if -d 'core';
+               push(@found, "@cores found in $_") if @cores;
+               chdir $cwdfh if $cwdfh;
+       }
+       return if !@found; # keep it quiet.
+       is(scalar(@found), 0, 'no core dumps found');
+       diag(join("\n", @found) . Carp::longmess());
+       if (-t STDIN) {
+               diag 'press ENTER to continue, (q) to quit';
+               chomp(my $line = <STDIN>);
+               xbail 'user quit' if $line =~ /\Aq/;
+       }
+}
+
 sub run_script ($;$$) {
        my ($cmd, $env, $opt) = @_;
+       no_coredump($opt->{-C} ? ($opt->{-C}) : ());
        my ($key, @argv) = @$cmd;
        my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 1;
        my $sub = $run_mode == 0 ? undef : key2sub($key);
@@ -383,6 +407,7 @@ sub run_script ($;$$) {
                local $/;
                $$redir = <$fh>;
        }
+       no_coredump($opt->{-C} ? ($opt->{-C}) : ());
        $? == 0;
 }
 
@@ -656,6 +681,7 @@ SKIP: {
                        File::Path::rmtree([glob("$home/*")]);
                        File::Path::rmtree("$home/.config");
                } else {
+                       no_coredump $tmpdir;
                        lei_ok(qw(daemon-pid), \"daemon-pid after $t");
                        chomp($daemon_pid = $lei_out);
                        if (!$daemon_pid) {
@@ -672,6 +698,7 @@ SKIP: {
                        tick;
                }
                ok(!kill(0, $daemon_pid), "$t daemon stopped");
+               no_coredump $tmpdir;
                my $f = "$daemon_xrd/lei/errors.log";
                open my $fh, '<', $f or BAIL_OUT "$f: $!";
                my @l = <$fh>;

diff --git a/t/lei-externals.t b/t/lei-externals.t
index aeaf8ee467a87b08728db12c2fd360b162b8e769..4f2dd6baf57e38729b4ced46a987e1fead6de860 100644 (file)
--- a/t/lei-externals.t
+++ b/t/lei-externals.t
@@ -48,6 +48,7 @@ SKIP: {
                $tp->join;
                ok(WIFSIGNALED($?), "signaled @$out");
                is(WTERMSIG($?), SIGPIPE, "got SIGPIPE @$out");
+               no_coredump;
                seek($err, 0, 0);
                my @err = <$err>;
                is_deeply(\@err, [], "no errors @$out");
@@ -66,6 +67,7 @@ SKIP: {
                        tick();
                }
                ok(!$alive, 'daemon-kill worked');
+               no_coredump;
        }
 } # /SKIP
 }; # /sub

diff --git a/xt/check-debris.t b/xt/check-debris.t
new file mode 100644 (file)
index 0000000..0bb5091
--- /dev/null
+++ b/xt/check-debris.t
@@ -0,0 +1,30 @@
+#!perl -w
+use v5.12;
+use autodie qw(open);
+use PublicInbox::TestCommon;
+use File::Spec;
+my $tmpdir = File::Spec->tmpdir;
+
+diag "note: writes to `$tmpdir' by others results in false-positives";
+
+my %cur = map { $_ => 1 } glob("$tmpdir/*");
+for my $t (@ARGV ? @ARGV : glob('t/*.t')) {
+       open my $fh, '-|', $^X, '-w', $t;
+       my @out;
+       while (<$fh>) {
+               chomp;
+               push @out, $_;
+               next if /^ok / || /\A[0-9]+\.\.[0-9]+\z/;
+               diag $_;
+       }
+       ok(close($fh), $t) or diag(explain(\@out));
+
+       no_coredump($tmpdir);
+
+       my @remain = grep { !$cur{$_}++ } glob("$tmpdir/*");
+       next if !@remain;
+       is_deeply(\@remain, [], "$t has no leftovers") or
+               diag "$t added: ",explain(\@remain);
+}
+
+done_testing;