diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | Makefile.PL | 6 | ||||
| -rw-r--r-- | lib/PublicInbox/TestCommon.pm | 29 | ||||
| -rw-r--r-- | t/lei-externals.t | 2 | ||||
| -rw-r--r-- | xt/check-debris.t | 30 |
5 files changed, 65 insertions, 3 deletions
@@ -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 a04a3b75..5b7914dc 100644 --- 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 4c819a4f..ae67a0ae 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; 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 aeaf8ee4..4f2dd6ba 100644 --- 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 index 00000000..0bb5091d --- /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; |