-# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
# internal APIs used only for tests
use POSIX qw(dup2);
use IO::Socket::INET;
our @EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
- run_script start_script key2sub xsys xqx eml_load tick);
+ run_script start_script key2sub xsys xsys_e xqx eml_load tick
+ have_xapian_compact);
+BEGIN {
+ require Test::More;
+ *BAIL_OUT = \&Test::More::BAIL_OUT;
+ *plan = \&Test::More::plan;
+ *skip = \&Test::More::skip;
+}
sub eml_load ($) {
my ($path, $cb) = @_;
Type => Socket::SOCK_STREAM(),
Listen => 1024,
Blocking => 0,
- ) or Test::More::BAIL_OUT("failed to create TCP server: $!");
+ ) or BAIL_OUT "failed to create TCP server: $!";
}
sub tcp_connect {
Type => Socket::SOCK_STREAM(),
PeerAddr => $addr,
%opt,
- ) or Test::More::BAIL_OUT("failed to connect to $addr: $!");
+ ) or BAIL_OUT "failed to connect to $addr: $!";
$s->autoflush(1);
$s;
}
my $cur_int = ($cur_maj << 24) | ($cur_min << 16) | ($cur_sub // 0);
if ($cur_int < $req_int) {
return 0 if $maybe;
- Test::More::plan(skip_all =>
- "git $req+ required, have $cur_maj.$cur_min.$cur_sub");
+ plan skip_all =>
+ "git $req+ required, have $cur_maj.$cur_min.$cur_sub";
}
1;
}
my $maybe = pop @mods if $mods[-1] =~ /\A[0-9]+\z/;
my @need;
while (my $mod = shift(@mods)) {
+ if ($mod eq 'json') {
+ $mod = 'Cpanel::JSON::XS||JSON::MaybeXS||'.
+ 'JSON||JSON::PP'
+ }
if ($mod eq 'Search::Xapian') {
if (eval { require PublicInbox::Search } &&
PublicInbox::Search::load_xapian()) {
}
return unless @need;
my $m = join(', ', @need)." missing for $0";
- Test::More::skip($m, $maybe) if $maybe;
- Test::More::plan(skip_all => $m)
+ skip($m, $maybe) if $maybe;
+ plan(skip_all => $m)
}
sub key2script ($) {
for (my $fd = 0; $fd <= $#io_mode; $fd++) {
my $fh = $fhref->[$fd] or next;
my ($oldfh, $mode) = @{$io_mode[$fd]};
- open my $orig, $mode, $oldfh or die "$$oldfh $mode stash: $!";
+ open my $orig, $mode, $oldfh or die "$oldfh $mode stash: $!";
$orig_io->[$fd] = $orig;
- open $oldfh, $mode, $fh or die "$$oldfh $mode redirect: $!";
+ open $oldfh, $mode, $fh or die "$oldfh $mode redirect: $!";
}
$orig_io;
}
# The default is 2.
our $run_script_exit_code;
sub RUN_SCRIPT_EXIT () { "RUN_SCRIPT_EXIT\n" };
-sub run_script_exit (;$) {
+sub run_script_exit {
$run_script_exit_code = $_[0] // 0;
die RUN_SCRIPT_EXIT;
}
-my %cached_scripts;
+our %cached_scripts;
sub key2sub ($) {
my ($key) = @_;
$cached_scripts{$key} //= do {
use strict;
use subs qw(exit);
-*exit = *PublicInbox::TestCommon::run_script_exit;
+*exit = \\&PublicInbox::TestCommon::run_script_exit;
sub main {
# the below "line" directive is a magic comment, see perlsyn(1) manpage
# line 1 "$f"
my $cmd = [ key2script($key), @argv ];
my $pid = PublicInbox::Spawn::spawn($cmd, $env, $spawn_opt);
if (defined $pid) {
- my $r = waitpid($pid, 0);
- defined($r) or die "waitpid: $!";
+ my $r = waitpid($pid, 0) // die "waitpid: $!";
$r == $pid or die "waitpid: expected $pid, got $r";
}
} else { # localize and run everything in the same process:
my $orig_io = _prepare_redirects($fhref);
_run_sub($sub, $key, \@argv);
_undo_redirects($orig_io);
+ select STDOUT;
}
# slurp the redirects back into user-supplied strings
$? >> 8
}
+sub xsys_e { # like "/bin/sh -e"
+ xsys(@_) == 0 or
+ BAIL_OUT (ref $_[0] ? "@{$_[0]}" : "@_"). " failed \$?=$?"
+}
+
# like `backtick` or qx{} op, but uses spawn() for env/rdr + vfork
sub xqx {
my ($cmd, $env, $rdr) = @_;
}
}
if (@paths) {
- defined($tail_pid = fork) or die "fork: $!\n";
+ $tail_pid = fork // die "fork: $!";
if ($tail_pid == 0) {
# make sure files exist, first
open my $fh, '>>', $_ for @paths;
wait_for_tail($tail_pid, scalar @paths);
}
}
- defined(my $pid = fork) or die "fork: $!\n";
+ my $pid = fork // die "fork: $!\n";
if ($pid == 0) {
eval { PublicInbox::DS->Reset };
# pretend to be systemd (cf. sd_listen_fds(3))
PublicInboxTestProcess->new($pid, $tail_pid);
}
+sub have_xapian_compact () {
+ require PublicInbox::Spawn;
+ # $ENV{XAPIAN_COMPACT} is used by PublicInbox/Xapcmd.pm, too
+ PublicInbox::Spawn::which($ENV{XAPIAN_COMPACT} || 'xapian-compact');
+}
+
package PublicInboxTestProcess;
use strict;
my ($self, $sig) = @_;
my $pid = delete $self->{pid} or return;
CORE::kill($sig, $pid) if defined $sig;
- my $ret = waitpid($pid, 0);
- defined($ret) or die "waitpid($pid): $!";
+ my $ret = waitpid($pid, 0) // die "waitpid($pid): $!";
$ret == $pid or die "waitpid($pid) != $ret";
}