use strict;
use parent qw(Exporter);
use v5.10.1;
-use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD :seek);
+use Fcntl qw(F_SETFD :seek);
use POSIX qw(dup2);
use IO::Socket::INET;
use File::Spec;
my $lei_loud = $ENV{TEST_LEI_ERR_LOUD};
my $tail_cmd = $ENV{TAIL};
our ($lei_opt, $lei_out, $lei_err, $lei_cwdfh);
+
+$_ = File::Spec->rel2abs($_) for (grep(!m!^/!, @INC));
+
BEGIN {
@EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
run_script start_script key2sub xsys xsys_e xqx eml_load tick
}
sub require_cmd ($;$) {
- my ($cmd, $maybe) = @_;
+ my ($cmd, $nr) = @_;
require PublicInbox::Spawn;
- my $bin = PublicInbox::Spawn::which($cmd);
+ state %CACHE;
+ my $bin = $CACHE{$cmd} //= PublicInbox::Spawn::which($cmd);
return $bin if $bin;
- $maybe ? 0 : plan(skip_all => "$cmd missing from PATH for $0");
+ return plan(skip_all => "$cmd missing from PATH for $0") if !$nr;
+ defined(wantarray) ? undef : skip("$cmd missing, skipping $nr tests")
}
-sub have_xapian_compact () {
- require_cmd($ENV{XAPIAN_COMPACT} || 'xapian-compact', 1);
+sub have_xapian_compact (;$) {
+ require_cmd($ENV{XAPIAN_COMPACT} || 'xapian-compact', @_ ? $_[0] : ());
}
sub require_git ($;$) {
- my ($req, $maybe) = @_;
- my ($req_maj, $req_min, $req_sub) = split(/\./, $req);
- my ($cur_maj, $cur_min, $cur_sub) = (xqx([qw(git --version)])
- =~ /version (\d+)\.(\d+)(?:\.(\d+))?/);
+ my ($req, $nr) = @_;
+ state ($cur_int, $cur_ver);
+ $cur_int //= do {
+ chomp($cur_ver = xqx([qw(git --version)]));
+ my @v = ($cur_ver =~ /version (\d+)\.(\d+)(?:\.(\d+))?/);
+ ($v[0] << 24) | ($v[1] << 16) | ($v[2] // 0);
+ };
+ my ($req_maj, $req_min, $req_sub) = split(/\./, $req);
my $req_int = ($req_maj << 24) | ($req_min << 16) | ($req_sub // 0);
- my $cur_int = ($cur_maj << 24) | ($cur_min << 16) | ($cur_sub // 0);
- if ($cur_int < $req_int) {
- return 0 if $maybe;
- plan skip_all =>
- "git $req+ required, have $cur_maj.$cur_min.$cur_sub";
- }
- 1;
+
+ return 1 if $cur_int >= $req_int;
+ return plan skip_all => "git $req+ required, have $cur_ver" if !$nr;
+ defined(wantarray) ? undef :
+ skip("git $req+ required (have $cur_ver), skipping $nr tests")
}
+my %IPv6_VERSION = (
+ 'Net::NNTP' => 3.00,
+ 'Mail::IMAPClient' => 3.40,
+ 'HTTP::Tiny' => 0.042,
+);
+
sub require_mods {
my @mods = @_;
my $maybe = pop @mods if $mods[-1] =~ /\A[0-9]+\z/;
push @mods, qw(Parse::RecDescent DBD::SQLite
Email::Address::XS||Mail::Address);
next;
- } elsif ($mod eq '-nntpd') {
+ } elsif ($mod eq '-nntpd' || $mod eq 'v2') {
push @mods, qw(DBD::SQLite);
next;
}
!eval{ IO::Socket::SSL->VERSION(2.007); 1 }) {
push @need, $@;
}
+ if (defined(my $v = $IPv6_VERSION{$mod})) {
+ $ENV{TEST_IPV4_ONLY} = 1 if !eval { $mod->VERSION($v) };
+ }
}
return unless @need;
my $m = join(', ', @need)." missing for $0";
my ($cmd, $env, $opt) = @_;
my ($key, @argv) = @$cmd;
my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 1;
+ $run_mode = 0 if $key eq '-clone'; # relies on SIGCHLD + waitpid(-1)
my $sub = $run_mode == 0 ? undef : key2sub($key);
my $fhref = [];
my $spawn_opt = {};
my $pid = fork // die "fork: $!\n";
if ($pid == 0) {
eval { PublicInbox::DS->Reset };
+ for (@{delete($opt->{-CLOFORK}) // []}) {
+ close($_) or die "close $!";
+ }
# pretend to be systemd (cf. sd_listen_fds(3))
# 3 == SD_LISTEN_FDS_START
my $fd;
- for ($fd = 0; 1; $fd++) {
- my $s = $opt->{$fd};
- last if $fd >= 3 && !defined($s);
- next unless $s;
- my $fl = fcntl($s, F_GETFD, 0);
- if (($fl & FD_CLOEXEC) != FD_CLOEXEC) {
- warn "got FD:".fileno($s)." w/o CLOEXEC\n";
+ for ($fd = 0; $fd < 3 || defined($opt->{$fd}); $fd++) {
+ my $io = $opt->{$fd} // next;
+ my $old = fileno($io);
+ if ($old == $fd) {
+ fcntl($io, F_SETFD, 0) // die "F_SETFD: $!";
+ } else {
+ dup2($old, $fd) // die "dup2($old, $fd): $!";
}
- fcntl($s, F_SETFD, $fl &= ~FD_CLOEXEC);
- dup2(fileno($s), $fd) or die "dup2 failed: $!\n";
}
%ENV = (%ENV, %$env) if $env;
my $fds = $fd - 3;
my $test_opt = shift // {};
local $lei_cwdfh;
opendir $lei_cwdfh, '.' or xbail "opendir .: $!";
- require_git(2.6, 1) or skip('git 2.6+ required for lei test', 2);
+ require_git(2.6, 1);
my $mods = $test_opt->{mods} // [ 'lei' ];
require_mods(@$mods, 2);
$ibx;
}
-sub test_httpd ($$;$) {
- my ($env, $client, $skip) = @_;
- for (qw(PI_CONFIG TMPDIR)) {
- $env->{$_} or BAIL_OUT "$_ unset";
- }
+sub test_httpd ($$;$$) {
+ my ($env, $client, $skip, $cb) = @_;
+ my ($tmpdir, $for_destroy);
+ $env->{TMPDIR} //= do {
+ ($tmpdir, $for_destroy) = tmpdir();
+ $tmpdir;
+ };
+ for (qw(PI_CONFIG)) { $env->{$_} or BAIL_OUT "$_ unset" }
SKIP: {
- require_mods(qw(Plack::Test::ExternalServer), $skip // 1);
+ require_mods(qw(Plack::Test::ExternalServer LWP::UserAgent),
+ $skip // 1);
my $sock = tcp_server() or die;
my ($out, $err) = map { "$env->{TMPDIR}/std$_.log" } qw(out err);
my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, $env, { 3 => $sock });
my ($h, $p) = tcp_host_port($sock);
local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
- Plack::Test::ExternalServer::test_psgi(client => $client);
+ my $ua = LWP::UserAgent->new;
+ $ua->max_redirect(0);
+ Plack::Test::ExternalServer::test_psgi(client => $client,
+ ua => $ua);
+ $cb->() if $cb;
$td->join('TERM');
open my $fh, '<', $err or BAIL_OUT $!;
my $e = do { local $/; <$fh> };