* [PATCH 4/6] t/*.t: avoid sharing "my" variables in subs
2019-12-18 3:36 7% [PATCH 0/6] test updates and speedups Eric Wong
@ 2019-12-18 3:36 7% ` Eric Wong
0 siblings, 0 replies; 2+ results
From: Eric Wong @ 2019-12-18 3:36 UTC (permalink / raw)
To: meta
These usages of file-local global variables make the *.t files
incompatible with run_script(). Instead, use anonymous subs,
"our", or pass the parameter as appropriate.
---
t/httpd-corner.t | 8 ++++----
t/indexlevels-mirror.t | 10 ++++-----
t/mda.t | 46 +++++++++++++++++++++---------------------
t/nntpd-tls.t | 2 +-
t/solver_git.t | 9 +++++----
t/v2mirror.t | 10 ++++-----
t/view.t | 12 +++++------
t/www_listing.t | 4 ++--
8 files changed, 50 insertions(+), 51 deletions(-)
diff --git a/t/httpd-corner.t b/t/httpd-corner.t
index 551af2b2..a8cdb2e9 100644
--- a/t/httpd-corner.t
+++ b/t/httpd-corner.t
@@ -553,16 +553,16 @@ SKIP: {
# filter out pipes inherited from the parent
my @this = `lsof -p $$`;
my $bad;
- sub extract_inodes {
+ my $extract_inodes = sub {
map {;
my @f = split(' ', $_);
my $inode = $f[-2];
$bad = $_ if $inode !~ /\A[0-9]+\z/;
$inode => 1;
} grep (/\bpipe\b/, @_);
- }
- my %child = extract_inodes(@lsof);
- my %parent = extract_inodes(@this);
+ };
+ my %child = $extract_inodes->(@lsof);
+ my %parent = $extract_inodes->(@this);
skip("inode not in expected format: $bad", 1) if defined($bad);
delete @child{(keys %parent)};
is_deeply([], [keys %child], 'no extra pipes with -W0');
diff --git a/t/indexlevels-mirror.t b/t/indexlevels-mirror.t
index 3d4813be..aae42510 100644
--- a/t/indexlevels-mirror.t
+++ b/t/indexlevels-mirror.t
@@ -16,8 +16,6 @@ foreach my $mod (qw(DBD::SQLite)) {
plan skip_all => "$mod missing for $0" if $@;
}
-my @xcpdb = qw(-xcpdb -q);
-
my $mime = PublicInbox::MIME->create(
header => [
From => 'a@example.com',
@@ -29,7 +27,7 @@ my $mime = PublicInbox::MIME->create(
);
sub import_index_incremental {
- my ($v, $level) = @_;
+ my ($v, $level, $mime) = @_;
my $this = "pi-$v-$level-indexlevels";
my ($tmpdir, $for_destroy) = tmpdir();
local $ENV{PI_CONFIG} = "$tmpdir/config";
@@ -120,7 +118,7 @@ sub import_index_incremental {
is_deeply(\@rw_nums, [1], 'unindex NNTP article'.$v.$level);
if ($level ne 'basic') {
- ok(run_script([@xcpdb, $mirror]), "v$v xcpdb OK");
+ ok(run_script(['-xcpdb', '-q', $mirror]), "v$v xcpdb OK");
is(PublicInbox::Admin::detect_indexlevel($ro_mirror), $level,
'indexlevel detectable by Admin after xcpdb v' .$v.$level);
delete $ro_mirror->{$_} for (qw(over search));
@@ -167,13 +165,13 @@ sub import_index_incremental {
}
# we can probably cull some other tests
-import_index_incremental($PI_TEST_VERSION, 'basic');
+import_index_incremental($PI_TEST_VERSION, 'basic', $mime);
SKIP: {
require PublicInbox::Search;
PublicInbox::Search::load_xapian() or skip 'Search::Xapian missing', 2;
foreach my $l (qw(medium full)) {
- import_index_incremental($PI_TEST_VERSION, $l);
+ import_index_incremental($PI_TEST_VERSION, $l, $mime);
}
}
diff --git a/t/mda.t b/t/mda.t
index 47d06132..3686a97b 100644
--- a/t/mda.t
+++ b/t/mda.t
@@ -23,6 +23,23 @@ my $faildir = "$home/faildir/";
my $mime;
my $git = PublicInbox::Git->new($maindir);
+my $fail_bad_header = sub ($$$) {
+ my ($good_rev, $msg, $in) = @_;
+ my @f = glob("$faildir/*/*");
+ unlink @f if @f;
+ my ($out, $err) = ("", "");
+ my $opt = { 0 => \$in, 1 => \$out, 2 => \$err };
+ local $ENV{PATH} = $main_path;
+ ok(run_script(['-mda'], undef, $opt),
+ "no error on undeliverable ($msg)");
+ my $rev = $git->qx(qw(rev-list HEAD));
+ chomp $rev;
+ is($rev, $good_rev, "bad revision not commited ($msg)");
+ @f = glob("$faildir/*/*");
+ is(scalar @f, 1, "faildir written to");
+ [ $in, $out, $err ];
+};
+
{
ok(-x "$main_bin/spamc",
"spamc ham mock found (run in top of source tree");
@@ -110,14 +127,14 @@ EOF
is(scalar @new, 1, "PI_EMERGENCY is written to");
}
- fail_bad_header($good_rev, "bad recipient", <<"");
+ $fail_bad_header->($good_rev, "bad recipient", <<"");
From: Me <me\@example.com>
To: You <you\@example.com>
Message-Id: <bad-recipient\@example.com>
Subject: hihi
Date: Thu, 01 Jan 1970 00:00:00 +0000
- my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
+ my $fail = $fail_bad_header->($good_rev, "duplicate Message-ID", <<"");
From: Me <me\@example.com>
To: You <you\@example.com>
Cc: $addr
@@ -127,26 +144,26 @@ Date: Thu, 01 Jan 1970 00:00:00 +0000
like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
- fail_bad_header($good_rev, "missing From:", <<"");
+ $fail_bad_header->($good_rev, "missing From:", <<"");
To: $addr
Message-ID: <missing-from\@example.com>
Subject: hihi
Date: Thu, 01 Jan 1970 00:00:00 +0000
- fail_bad_header($good_rev, "short subject:", <<"");
+ $fail_bad_header->($good_rev, "short subject:", <<"");
To: $addr
From: cat\@example.com
Message-ID: <short-subject\@example.com>
Subject: a
Date: Thu, 01 Jan 1970 00:00:00 +0000
- fail_bad_header($good_rev, "no date", <<"");
+ $fail_bad_header->($good_rev, "no date", <<"");
To: $addr
From: u\@example.com
Message-ID: <no-date\@example.com>
Subject: hihi
- fail_bad_header($good_rev, "bad date", <<"");
+ $fail_bad_header->($good_rev, "bad date", <<"");
To: $addr
From: u\@example.com
Message-ID: <bad-date\@example.com>
@@ -329,20 +346,3 @@ EOF
}
done_testing();
-
-sub fail_bad_header {
- my ($good_rev, $msg, $in) = @_;
- my @f = glob("$faildir/*/*");
- unlink @f if @f;
- my ($out, $err) = ("", "");
- my $opt = { 0 => \$in, 1 => \$out, 2 => \$err };
- local $ENV{PATH} = $main_path;
- ok(run_script(['-mda'], undef, $opt),
- "no error on undeliverable ($msg)");
- my $rev = $git->qx(qw(rev-list HEAD));
- chomp $rev;
- is($rev, $good_rev, "bad revision not commited ($msg)");
- @f = glob("$faildir/*/*");
- is(scalar @f, 1, "faildir written to");
- [ $in, $out, $err ];
-}
diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t
index bbcc04c0..c6dceaaa 100644
--- a/t/nntpd-tls.t
+++ b/t/nntpd-tls.t
@@ -28,7 +28,7 @@ require './t/common.perl';
require PublicInbox::InboxWritable;
require PublicInbox::MIME;
require PublicInbox::SearchIdx;
-my $need_zlib;
+our $need_zlib;
eval { require Compress::Raw::Zlib } or
$need_zlib = 'Compress::Raw::Zlib missing';
my $version = 2; # v2 needs newer git
diff --git a/t/solver_git.t b/t/solver_git.t
index 6bac17ea..88f83bdb 100644
--- a/t/solver_git.t
+++ b/t/solver_git.t
@@ -32,15 +32,16 @@ my $ibx = PublicInbox::Inbox->new($opts);
my $im = PublicInbox::V2Writable->new($ibx, 1);
$im->{parallel} = 0;
-sub deliver_patch ($) {
+my $deliver_patch = sub ($) {
open my $fh, '<', $_[0] or die "open: $!";
my $mime = PublicInbox::MIME->new(do { local $/; <$fh> });
$im->add($mime);
$im->done;
-}
+};
-deliver_patch('t/solve/0001-simple-mod.patch');
+$deliver_patch->('t/solve/0001-simple-mod.patch');
my $v1_0_0_tag = 'cb7c42b1e15577ed2215356a2bf925aef59cdd8d';
+
my $git = PublicInbox::Git->new($git_dir);
is('public-inbox 1.0.0',
$git->commit_title($v1_0_0_tag),
@@ -96,7 +97,7 @@ $solver = PublicInbox::SolverGit->new($ibx, sub { $res = $_[0] });
$solver->solve($psgi_env, $log, $git_v2_20_1_tag, {});
is($res, undef, 'no error on a tag not in our repo');
-deliver_patch('t/solve/0002-rename-with-modifications.patch');
+$deliver_patch->('t/solve/0002-rename-with-modifications.patch');
$solver = PublicInbox::SolverGit->new($ibx, sub { $res = $_[0] });
$solver->solve($psgi_env, $log, '0a92431', {});
ok($res, 'resolved without hints');
diff --git a/t/v2mirror.t b/t/v2mirror.t
index a45a262e..213a5f15 100644
--- a/t/v2mirror.t
+++ b/t/v2mirror.t
@@ -97,15 +97,15 @@ for my $i (10..15) {
$v2w->done;
$ibx->cleanup;
-sub fetch_each_epoch {
+my $fetch_each_epoch = sub {
foreach my $i (0..$epoch_max) {
my $dir = "$tmpdir/m/git/$i.git";
is(system('git', "--git-dir=$dir", 'fetch', '-q'), 0,
'fetch successful');
}
-}
+};
-fetch_each_epoch();
+$fetch_each_epoch->();
my $mset = $mibx->search->reopen->query('m:15@example.com', {mset => 1});
is(scalar($mset->items), 0, 'new message not found in mirror, yet');
@@ -135,7 +135,7 @@ like($to_purge, qr/\A[a-f0-9]{40,}\z/, 'read blob to be purged');
$mset = $ibx->search->reopen->query('m:10@example.com', {mset => 1});
is(scalar($mset->items), 0, 'purged message gone from origin');
-fetch_each_epoch();
+$fetch_each_epoch->();
{
$ibx->cleanup;
PublicInbox::InboxWritable::cleanup($mibx);
@@ -173,7 +173,7 @@ is($mibx->git->check($to_purge), undef, 'unindex+prune successful in mirror');
ok($v2w->remove($mime), 'removed <1@example.com> from source');
$v2w->done;
$ibx->cleanup;
- fetch_each_epoch();
+ $fetch_each_epoch->();
PublicInbox::InboxWritable::cleanup($mibx);
my $cmd = [ "-index", "$tmpdir/m" ];
diff --git a/t/view.t b/t/view.t
index 1de3a02c..92962b15 100644
--- a/t/view.t
+++ b/t/view.t
@@ -24,8 +24,8 @@ my $ctx = {
};
$ctx->{-inbox}->{-primary_address} = 'test@example.com';
-sub msg_html ($) {
- my ($mime) = @_;
+sub msg_html ($$) {
+ my ($ctx, $mime) = @_;
my $s = '';
my $r = PublicInbox::View::msg_html($ctx, $mime);
@@ -72,7 +72,7 @@ EOF
body => $body,
)->as_string;
my $mime = Email::MIME->new($s);
- my $html = msg_html($mime);
+ my $html = msg_html($ctx, $mime);
# ghetto tests
like($html, qr!<a\nhref="raw"!s, "raw link present");
@@ -102,7 +102,7 @@ EOF
parts => $parts,
);
- my $html = msg_html($mime);
+ my $html = msg_html($ctx, $mime);
like($html, qr/hi\n.*-- Attachment #2.*\nbye\n/s, "multipart split");
}
@@ -131,7 +131,7 @@ EOF
parts => $parts,
);
- my $html = msg_html($mime);
+ my $html = msg_html($ctx, $mime);
like($html, qr!.*Attachment #2: foo&(?:amp|#38);\.patch --!,
"parts split with filename");
}
@@ -157,7 +157,7 @@ EOF
);
my $orig = $mime->body_raw;
- my $html = msg_html($mime);
+ my $html = msg_html($ctx, $mime);
like($orig, qr/hi =3D bye=/, "our test used QP correctly");
like($html, qr/\bhi = bye\b/, "HTML output decoded QP");
}
diff --git a/t/www_listing.t b/t/www_listing.t
index c9201213..e1263360 100644
--- a/t/www_listing.t
+++ b/t/www_listing.t
@@ -33,7 +33,7 @@ like(PublicInbox::WwwListing::fingerprint($bare), qr/\A[a-f0-9]{40}\z/,
'got fingerprint with non-empty repo');
sub tiny_test {
- my ($host, $port) = @_;
+ my ($json, $host, $port) = @_;
my $http = HTTP::Tiny->new;
my $res = $http->get("http://$host:$port/manifest.js.gz");
is($res->{status}, 200, 'got manifest');
@@ -107,7 +107,7 @@ SKIP: {
$td = start_script($cmd, $env, { 3 => $sock });
$sock = undef;
- tiny_test($host, $port);
+ tiny_test($json, $host, $port);
skip 'skipping grok-pull integration test', 2 if !which('grok-pull');
^ permalink raw reply related [relevance 7%]
* [PATCH 0/6] test updates and speedups
@ 2019-12-18 3:36 7% Eric Wong
2019-12-18 3:36 7% ` [PATCH 4/6] t/*.t: avoid sharing "my" variables in subs Eric Wong
0 siblings, 1 reply; 2+ 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 7%]
Results 1-2 of 2 | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2019-12-18 3:36 7% [PATCH 0/6] test updates and speedups Eric Wong
2019-12-18 3:36 7% ` [PATCH 4/6] t/*.t: avoid sharing "my" variables in subs 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).