* Re: [PATCH 6/6] t/run.perl: to avoid repeated process spawning for *.t
2019-12-18 3:36 3% ` [PATCH 6/6] t/run.perl: to avoid repeated process spawning for *.t Eric Wong
@ 2019-12-19 4:03 7% ` Eric Wong
0 siblings, 0 replies; 3+ results
From: Eric Wong @ 2019-12-19 4:03 UTC (permalink / raw)
To: meta
Eric Wong <e@80x24.org> wrote:
> +# *.t files run by this shouldnot rely on global state.
s/shouldnot/should not/
diff --git a/t/run.perl b/t/run.perl
index 15d1f7e0..9f987a6f 100755
--- a/t/run.perl
+++ b/t/run.perl
@@ -6,7 +6,7 @@
# to give a nice speedup over prove(1). It also generates per-test
# .log files (similar to automake tests).
#
-# *.t files run by this shouldnot rely on global state.
+# *.t files run by this should not rely on global state.
#
# Usage: $PERL -I lib -w t/run.perl -j4
# Or via prove(1): prove -lvw t/run.perl :: -j4
^ permalink raw reply related [relevance 7%]
* [PATCH 6/6] t/run.perl: to avoid repeated process spawning for *.t
2019-12-18 3:36 4% [PATCH 0/6] test updates and speedups Eric Wong
@ 2019-12-18 3:36 3% ` Eric Wong
2019-12-19 4:03 7% ` Eric Wong
0 siblings, 1 reply; 3+ results
From: Eric Wong @ 2019-12-18 3:36 UTC (permalink / raw)
To: meta
Spawning a new Perl interpreter for every test case
means Perl has to reparse and recompile every single file
it needs, costing us performance and development time.
Now that we've modified our code to avoid global state,
we can preload everything we need.
The new "check-run" test target is now 20-30% faster
than the original "check" target.
---
.gitignore | 1 +
MANIFEST | 1 +
Makefile.PL | 12 ++-
lib/PublicInbox/TestCommon.pm | 12 ++-
t/nntpd.t | 3 +
t/run.perl | 182 ++++++++++++++++++++++++++++++++++
6 files changed, 205 insertions(+), 6 deletions(-)
create mode 100755 t/run.perl
diff --git a/.gitignore b/.gitignore
index bdb8cf15..7f4142ba 100644
--- a/.gitignore
+++ b/.gitignore
@@ -19,3 +19,4 @@
/NEWS.html
/NEWS.atom
/NEWS
+*.log
diff --git a/MANIFEST b/MANIFEST
index 6bff79ad..997b6e88 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -265,6 +265,7 @@ t/purge.t
t/qspawn.t
t/replace.t
t/reply.t
+t/run.perl
t/search-thr-index.t
t/search.t
t/sigfd.t
diff --git a/Makefile.PL b/Makefile.PL
index 33688095..70eb94c1 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -168,8 +168,16 @@ dsyn :: \$(addsuffix .syntax, \$(filter \$(changed), \$(syn_files)))
check-manifest :: MANIFEST
if git ls-files >\$?.gen 2>&1; then diff -u \$? \$?.gen; fi
-check:: pure_all check-manifest
- \$(EATMYDATA) \$(PROVE) -bvw -j\$(N)
+# the traditional way running per-*.t processes:
+check-each :: pure_all check-manifest
+ \$(EATMYDATA) \$(PROVE) --state=save -bvw -j\$(N)
+
+# lightly-tested way to runn tests, relies "--state=save" in check-each
+# for best performance
+check-run :: pure_all check-manifest
+ \$(EATMYDATA) \$(PROVE) -bvw t/run.perl :: -j\$(N)
+
+check :: check-each
lib/PublicInbox/UserContent.pm :: contrib/css/216dark.css
\$(PERL) -I lib \$@ \$?
diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 2804b5b6..d6ed0876 100644
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -60,7 +60,7 @@ sub require_git ($;$) {
sub key2script ($) {
my ($key) = @_;
- return $key if $key =~ m!\A/!;
+ return $key if (index($key, '/') >= 0);
# n.b. we may have scripts which don't start with "public-inbox" in
# the future:
$key =~ s/\A([-\.])/public-inbox$1/;
@@ -101,9 +101,11 @@ sub key2sub ($) {
my $f = key2script($key);
open my $fh, '<', $f or die "open $f: $!";
my $str = do { local $/; <$fh> };
- my ($fc, $rest) = ($key =~ m/([a-z])([a-z0-9]+)\z/);
- $fc = uc($fc);
- my $pkg = "PublicInbox::TestScript::$fc$rest";
+ my $pkg = (split(m!/!, $f))[-1];
+ $pkg =~ s/([a-z])([a-z0-9]+)(\.t)?\z/\U$1\E$2/;
+ $pkg .= "_T" if $3;
+ $pkg =~ tr/-.//d;
+ $pkg = "PublicInbox::TestScript::$pkg";
eval <<EOF;
package $pkg;
use strict;
@@ -111,6 +113,8 @@ use subs qw(exit);
*exit = *PublicInbox::TestCommon::run_script_exit;
sub main {
+# the below "line" directive is a magic comment, see perlsyn(1) manpage
+# line 1 "$f"
$str
0;
}
diff --git a/t/nntpd.t b/t/nntpd.t
index 30f3fb9c..c3712b67 100644
--- a/t/nntpd.t
+++ b/t/nntpd.t
@@ -302,6 +302,9 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000
is($? >> 8, 0, 'no errors');
}
SKIP: {
+ if ($INC{'Search/Xapian.pm'} && ($ENV{TEST_RUN_MODE}//1)) {
+ skip 'Search/Xapian.pm pre-loaded (by t/run.perl?)', 1;
+ }
my @of = `lsof -p $td->{pid} 2>/dev/null`;
skip('lsof broken', 1) if (!scalar(@of) || $?);
my @xap = grep m!Search/Xapian!, @of;
diff --git a/t/run.perl b/t/run.perl
new file mode 100755
index 00000000..15d1f7e0
--- /dev/null
+++ b/t/run.perl
@@ -0,0 +1,182 @@
+#!/usr/bin/perl -w
+# Copyright (C) 2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Parallel test runner which preloads code and reuses worker processes
+# to give a nice speedup over prove(1). It also generates per-test
+# .log files (similar to automake tests).
+#
+# *.t files run by this shouldnot rely on global state.
+#
+# Usage: $PERL -I lib -w t/run.perl -j4
+# Or via prove(1): prove -lvw t/run.perl :: -j4
+use strict;
+use PublicInbox::TestCommon;
+use Cwd qw(getcwd);
+use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev);
+use Errno qw(EINTR);
+use POSIX qw(_POSIX_PIPE_BUF WNOHANG);
+my $jobs = 1;
+my $repeat = 1;
+$| = 1;
+our $log_suffix = '.log';
+my ($shuffle, %pids, @err);
+GetOptions('j|jobs=i' => \$jobs,
+ 'repeat=i' => \$repeat,
+ 'log=s' => \$log_suffix,
+ 's|shuffle' => \$shuffle,
+) or die "Usage: $0 [-j JOBS] [--log=SUFFIX] [--repeat RUNS]";
+if (($ENV{TEST_RUN_MODE} // 1) == 0) {
+ die "$0 is not compatible with TEST_RUN_MODE=0\n";
+}
+my @tests = scalar(@ARGV) ? @ARGV : glob('t/*.t');
+my $cwd = getcwd();
+open OLDOUT, '>&STDOUT' or die "dup STDOUT: $!";
+open OLDERR, '>&STDERR' or die "dup STDERR: $!";
+OLDOUT->autoflush(1);
+OLDERR->autoflush(1);
+
+key2sub($_) for @tests; # precache
+
+if ($shuffle) {
+ require List::Util;
+} elsif (open(my $prove_state, '<', '.prove') && eval { require YAML::XS }) {
+ # reuse "prove --state=save" data to start slowest tests, first
+ my $state = YAML::XS::Load(do { local $/; <$prove_state> });
+ my $t = $state->{tests};
+ @tests = sort {
+ ($t->{$b}->{elapsed} // 0) <=> ($t->{$a}->{elapsed} // 0)
+ } @tests;
+}
+
+our $tb = Test::More->builder;
+
+sub DIE (;$) {
+ print OLDERR @_;
+ exit(1);
+}
+
+our ($worker, $worker_test);
+
+sub test_status () {
+ $? = 255 if $? == 0 && !$tb->is_passing;
+ my $status = $? ? 'not ok' : 'ok';
+ print OLDOUT "$status $worker_test\n" if $log_suffix ne '';
+}
+
+# Test::Builder or Test2::Hub may call exit() from plan(skip_all => ...)
+END { test_status() if (defined($worker_test) && $worker == $$) }
+
+sub run_test ($) {
+ my ($test) = @_;
+ my $log_fh;
+ if ($log_suffix ne '') {
+ my $log = $test;
+ $log =~ s/\.[^\.]+\z/$log_suffix/ or DIE "can't log for $test";
+ open $log_fh, '>', $log or DIE "open $log: $!";
+ $log_fh->autoflush(1);
+ $tb->output($log_fh);
+ $tb->failure_output($log_fh);
+ $tb->todo_output($log_fh);
+ open STDOUT, '>&', $log_fh or DIE "1>$log: $!";
+ open STDERR, '>&', $log_fh or DIE "2>$log: $!";
+ }
+ $worker_test = $test;
+ run_script([$test]);
+ test_status();
+ $worker_test = undef;
+ push @err, "$test ($?)" if $?;
+}
+
+sub UINT_SIZE () { 4 }
+
+# worker processes will SIGUSR1 the producer process when it
+# sees EOF on the pipe. On FreeBSD 11.2 and Perl 5.30.0,
+# sys/ioctl.ph gives the wrong value for FIONREAD().
+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: $!";
+ if ($pid == 0) {
+ $worker = $$;
+ while (1) {
+ my $r = sysread($rd, my $buf, UINT_SIZE);
+ if (!defined($r)) {
+ next if $! == EINTR;
+ DIE "sysread: $!";
+ }
+ last if $r == 0;
+ DIE "short read $r" if $r != UINT_SIZE;
+ my $t = unpack('I', $buf);
+ run_test($todo->[$t]);
+ $tb->reset;
+ chdir($cwd) or DIE "chdir: $!";
+ }
+ kill 'USR1', $producer if !$eof; # sets $eof in $producer
+ DIE join('', map { "E: $_\n" } @err) if @err;
+ exit(0);
+ } else {
+ $pids{$pid} = $j;
+ }
+};
+
+# negative $repeat means loop forever:
+for (my $i = $repeat; $i != 0; $i--) {
+ my @todo = $shuffle ? List::Util::shuffle(@tests) : @tests;
+
+ # single-producer, multi-consumer queue relying on POSIX semantics
+ 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;
+ } else { # write what we can...
+ $wr->autoflush(1);
+ print $wr join('', map { pack('I', $_) } (0..$n)) or DIE;
+ $n += 1; # and send more ($n..$#todo), later
+ }
+ $eof = undef;
+ local $SIG{USR1} = sub { $eof = 1 };
+ my $sigchld = sub {
+ my ($sig) = @_;
+ my $flags = $sig ? WNOHANG : 0;
+ while (1) {
+ my $pid = waitpid(-1, $flags) or return;
+ return if $pid < 0;
+ my $j = delete $pids{$pid};
+ if (!defined($j)) {
+ push @err, "reaped unknown $pid ($?)";
+ next;
+ }
+ push @err, "job[$j] ($?)" if $?;
+ # skip_all can exit(0), respawn if needed:
+ if (!$eof) {
+ print OLDERR "# respawning job[$j]\n";
+ $start_worker->($i, $j, $rd, \@todo);
+ }
+ }
+ };
+
+ # start the workers to consume the queue
+ for (my $j = 0; $j < $jobs; $j++) {
+ $start_worker->($i, $j, $rd, \@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;
+ }
+
+ $sigchld->(0) while scalar(keys(%pids));
+ DIE join('', map { "E: $_\n" } @err) if @err;
+}
+
+print OLDOUT "1..".($repeat * scalar(@tests))."\n" if $repeat >= 0;
^ permalink raw reply related [relevance 3%]
* [PATCH 0/6] test updates and speedups
@ 2019-12-18 3:36 4% Eric Wong
2019-12-18 3:36 3% ` [PATCH 6/6] t/run.perl: to avoid repeated process spawning for *.t Eric Wong
0 siblings, 1 reply; 3+ results
From: Eric Wong @ 2019-12-18 3:36 UTC (permalink / raw)
To: meta
Tests are now faster with the "make check-run" target by
avoiding Perl startup time for each *.t file.
"make check-run" is nearly 3x faster than "make check"
under 1.2.0 due to the dozens of internal improvements
and cleanups since 1.2.0.
I've also beefed up the "solver" tests to cover the ViewVCS
PSGI frontend, more work there on the horizon...
Eric Wong (6):
TODO: add UUCP address item
viewvcs: flesh out some functionality and test
Makefile.PL: sort target and var lists
t/*.t: avoid sharing "my" variables in subs
tests: move t/common.perl to PublicInbox::TestCommon
t/run.perl: to avoid repeated process spawning for *.t
.gitignore | 1 +
MANIFEST | 3 +-
Makefile.PL | 20 +-
TODO | 2 +
.../PublicInbox/TestCommon.pm | 28 ++-
lib/PublicInbox/ViewVCS.pm | 8 +-
t/admin.t | 2 +-
t/altid.t | 2 +-
t/altid_v2.t | 2 +-
t/cgi.t | 2 +-
t/config.t | 2 +-
t/convert-compact.t | 2 +-
t/edit.t | 2 +-
t/emergency.t | 2 +-
t/feed.t | 2 +-
t/filter_rubylang.t | 2 +-
t/git.t | 2 +-
t/html_index.t | 2 +-
t/httpd-corner.t | 10 +-
t/httpd-https.t | 2 +-
t/httpd-unix.t | 2 +-
t/httpd.t | 2 +-
t/import.t | 2 +-
t/indexlevels-mirror.t | 12 +-
t/init.t | 2 +-
t/mda.t | 48 ++---
t/mda_filter_rubylang.t | 2 +-
t/msgmap.t | 2 +-
t/nntpd-tls.t | 4 +-
t/nntpd.t | 5 +-
t/nulsubject.t | 2 +-
t/over.t | 2 +-
t/plack.t | 2 +-
t/psgi_attach.t | 2 +-
t/psgi_bad_mids.t | 2 +-
t/psgi_mount.t | 2 +-
t/psgi_multipart_not.t | 2 +-
t/psgi_scan_all.t | 2 +-
t/psgi_search.t | 2 +-
t/psgi_text.t | 2 +-
t/psgi_v2.t | 2 +-
t/purge.t | 2 +-
t/replace.t | 2 +-
t/run.perl | 182 ++++++++++++++++++
t/search-thr-index.t | 2 +-
t/search.t | 2 +-
t/solver_git.t | 86 ++++++++-
t/spamcheck_spamc.t | 2 +-
t/v1-add-remove-add.t | 2 +-
t/v1reindex.t | 2 +-
t/v2-add-remove-add.t | 2 +-
t/v2mda.t | 2 +-
t/v2mirror.t | 12 +-
t/v2reindex.t | 2 +-
t/v2writable.t | 2 +-
t/view.t | 12 +-
t/watch_filter_rubylang.t | 2 +-
t/watch_maildir.t | 2 +-
t/watch_maildir_v2.t | 2 +-
t/www_listing.t | 6 +-
t/xcpdb-reshard.t | 2 +-
xt/git-http-backend.t | 2 +-
xt/nntpd-validate.t | 2 +-
xt/perf-msgview.t | 2 +-
xt/perf-nntpd.t | 2 +-
65 files changed, 404 insertions(+), 133 deletions(-)
rename t/common.perl => lib/PublicInbox/TestCommon.pm (90%)
create mode 100755 t/run.perl
^ permalink raw reply [relevance 4%]
Results 1-3 of 3 | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2019-12-18 3:36 4% [PATCH 0/6] test updates and speedups Eric Wong
2019-12-18 3:36 3% ` [PATCH 6/6] t/run.perl: to avoid repeated process spawning for *.t Eric Wong
2019-12-19 4:03 7% ` Eric Wong
Code repositories for project(s) associated with this public inbox
https://80x24.org/public-inbox.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).