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');