X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FTestCommon.pm;h=56f04bd42e2c20be3531bfb7beb60537e01874a7;hb=af0b0fb7a454470a32c452119d0392e0dedb3fe1;hp=14ebba10563fc3abd5e22146b89b64fd3e5978e0;hpb=fac2f5b63f0595b67a99784c8a9f9801c1fc9f09;p=public-inbox.git
diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 14ebba10..56f04bd4 100644
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2015-2020 all contributors
+# Copyright (C) 2015-2021 all contributors
# License: AGPL-3.0+
# internal APIs used only for tests
@@ -10,7 +10,14 @@ use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD :seek);
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) = @_;
@@ -37,7 +44,7 @@ sub tcp_server () {
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 {
@@ -48,22 +55,23 @@ 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;
}
sub require_git ($;$) {
my ($req, $maybe) = @_;
- my ($req_maj, $req_min) = split(/\./, $req);
- my ($cur_maj, $cur_min) = (`git --version` =~ /version (\d+)\.(\d+)/);
+ 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_int = ($req_maj << 24) | ($req_min << 16);
- my $cur_int = ($cur_maj << 24) | ($cur_min << 16);
+ 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;
- Test::More::plan(skip_all =>
- "git $req+ required, have $cur_maj.$cur_min");
+ plan skip_all =>
+ "git $req+ required, have $cur_maj.$cur_min.$cur_sub";
}
1;
}
@@ -73,6 +81,10 @@ sub require_mods {
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()) {
@@ -107,8 +119,8 @@ sub require_mods {
}
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 ($) {
@@ -157,12 +169,12 @@ sub _undo_redirects ($) {
# 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 {
@@ -179,7 +191,7 @@ package $pkg;
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"
@@ -255,6 +267,7 @@ sub run_script ($;$$) {
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
@@ -275,11 +288,11 @@ sub tick (;$) {
}
sub wait_for_tail ($;$) {
- my ($tail_pid, $stop) = @_;
+ my ($tail_pid, $want) = @_;
my $wait = 2;
if ($^O eq 'linux') { # GNU tail may use inotify
state $tail_has_inotify;
- return tick if $stop && $tail_has_inotify;
+ return tick if $want < 0 && $tail_has_inotify;
my $end = time + $wait;
my @ino;
do {
@@ -296,7 +309,7 @@ sub wait_for_tail ($;$) {
local $/ = "\n";
@info = grep(/^inotify wd:/, <$fh>);
}
- } while (scalar(@info) < 2 && time <= $end and tick);
+ } while (scalar(@info) < $want && time <= $end and tick);
} else {
sleep($wait);
}
@@ -316,6 +329,11 @@ sub xsys {
$? >> 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) = @_;
@@ -336,6 +354,18 @@ sub start_script {
next unless /\A--std(?:err|out)=(.+)\z/;
push @paths, $1;
}
+ if ($opt) {
+ for (1, 2) {
+ my $f = $opt->{$_} or next;
+ if (!ref($f)) {
+ push @paths, $f;
+ } elsif (ref($f) eq 'GLOB' && $^O eq 'linux') {
+ my $fd = fileno($f);
+ my $f = readlink "/proc/$$/fd/$fd";
+ push @paths, $f if -e $f;
+ }
+ }
+ }
if (@paths) {
defined($tail_pid = fork) or die "fork: $!\n";
if ($tail_pid == 0) {
@@ -345,7 +375,7 @@ sub start_script {
exec(split(' ', $tail_cmd), @paths);
die "$tail_cmd failed: $!";
}
- wait_for_tail($tail_pid);
+ wait_for_tail($tail_pid, scalar @paths);
}
}
defined(my $pid = fork) or die "fork: $!\n";
@@ -384,6 +414,12 @@ sub start_script {
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;
@@ -413,7 +449,7 @@ sub DESTROY {
my ($self) = @_;
return if $self->{owner} != $$;
if (my $tail_pid = delete $self->{tail_pid}) {
- PublicInbox::TestCommon::wait_for_tail($tail_pid, 1);
+ PublicInbox::TestCommon::wait_for_tail($tail_pid, -1);
CORE::kill('TERM', $tail_pid);
}
$self->join('TERM');