]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/TestCommon.pm
update copyrights for 2021
[public-inbox.git] / lib / PublicInbox / TestCommon.pm
index b03e93e0f5b8e6fa96708467f210bf0167b54055..56f04bd42e2c20be3531bfb7beb60537e01874a7 100644 (file)
@@ -1,4 +1,4 @@
-# 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
@@ -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,7 +55,7 @@ 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;
 }
@@ -63,8 +70,8 @@ sub require_git ($;$) {
        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;
 }
@@ -74,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()) {
@@ -108,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 ($) {
@@ -158,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 {
@@ -180,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"
@@ -256,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
@@ -317,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) = @_;
@@ -397,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;