]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/TestCommon.pm
test_common: require_mods bundles
[public-inbox.git] / lib / PublicInbox / TestCommon.pm
index 6ca691746fa55a40842740ecc3b8670467ebf548..d36a63aa29aaa310c4b647db0e22150b1a3bfaa4 100644 (file)
@@ -11,11 +11,13 @@ use POSIX qw(dup2);
 use IO::Socket::INET;
 use File::Spec;
 our @EXPORT;
+my $lei_loud = $ENV{TEST_LEI_ERR_LOUD};
 BEGIN {
        @EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
                run_script start_script key2sub xsys xsys_e xqx eml_load tick
                have_xapian_compact json_utf8 setup_public_inboxes create_inbox
-               tcp_host_port test_lei lei lei_ok $lei_out $lei_err $lei_opt);
+               tcp_host_port test_lei lei lei_ok $lei_out $lei_err $lei_opt
+               test_httpd xbail);
        require Test::More;
        my @methods = grep(!/\W/, @Test::More::EXPORT);
        eval(join('', map { "*$_=\\&Test::More::$_;" } @methods));
@@ -23,6 +25,8 @@ BEGIN {
        push @EXPORT, @methods;
 }
 
+sub xbail (@) { BAIL_OUT join(' ', map { ref ? (explain($_)) : ($_) } @_) }
+
 sub eml_load ($) {
        my ($path, $cb) = @_;
        open(my $fh, '<', $path) or die "open $path: $!";
@@ -103,20 +107,29 @@ sub require_mods {
        my $maybe = pop @mods if $mods[-1] =~ /\A[0-9]+\z/;
        my @need;
        while (my $mod = shift(@mods)) {
+               if ($mod eq 'lei') {
+                       require_git(2.6, $maybe ? $maybe : ());
+                       push @mods, qw(DBD::SQLite Search::Xapian);
+                       $mod = 'json'; # fall-through
+               }
                if ($mod eq 'json') {
-                       $mod = 'Cpanel::JSON::XS||JSON::MaybeXS||'.
-                               'JSON||JSON::PP'
+                       $mod = 'Cpanel::JSON::XS||JSON::MaybeXS||JSON||JSON::PP'
+               } elsif ($mod eq '-httpd') {
+                       push @mods, qw(Plack::Builder Plack::Util);
+                       next;
+               } elsif ($mod eq '-imapd') {
+                       push @mods, qw(Parse::RecDescent DBD::SQLite
+                                       Email::Address::XS||Mail::Address);
+                       next;
+               } elsif ($mod eq '-nntpd') {
+                       push @mods, qw(DBD::SQLite);
+                       next;
                }
                if ($mod eq 'Search::Xapian') {
                        if (eval { require PublicInbox::Search } &&
                                PublicInbox::Search::load_xapian()) {
                                next;
                        }
-               } elsif ($mod eq 'Search::Xapian::WritableDatabase') {
-                       if (eval { require PublicInbox::SearchIdx } &&
-                               PublicInbox::SearchIdx::load_xapian_writable()){
-                                       next;
-                       }
                } elsif (index($mod, '||') >= 0) { # "Foo||Bar"
                        my $ok;
                        for my $m (split(/\Q||\E/, $mod)) {
@@ -290,6 +303,7 @@ sub run_script ($;$$) {
                local $0 = join(' ', @$cmd);
                my $orig_io = _prepare_redirects($fhref);
                _run_sub($sub, $key, \@argv);
+               eval { PublicInbox::Inbox::cleanup_task() };
                _undo_redirects($orig_io);
                select STDOUT;
        }
@@ -456,17 +470,29 @@ sub lei (@) {
        my $res = run_script(['lei', @$cmd], $env, $xopt // $lei_opt);
        $err_skip and
                $lei_err = join('', grep(!/$err_skip/, split(/^/m, $lei_err)));
+       if ($lei_err ne '') {
+               if ($lei_err =~ /Use of uninitialized/ ||
+                       $lei_err =~ m!\bArgument .*? isn't numeric in !) {
+                       fail "lei_err=$lei_err";
+               } else {
+                       diag "lei_err=$lei_err" if $lei_loud;
+               }
+       }
        $res;
 };
 
 sub lei_ok (@) {
+       state $PWD = $ENV{PWD} // Cwd::getcwd();
        my $msg = ref($_[-1]) eq 'SCALAR' ? pop(@_) : undef;
        my $tmpdir = quotemeta(File::Spec->tmpdir);
        # filter out anything that looks like a path name for consistent logs
        my @msg = ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_;
-       for (@msg) {
-               s!\A([a-z0-9]+://)[^/]+/!$1\$HOST_PORT/! ||
-                       s!$tmpdir\b/(?:[^/]+/)?!\$TMPDIR/!;
+       if (!$lei_loud) {
+               for (@msg) {
+                       s!\A([a-z0-9]+://)[^/]+/!$1\$HOST_PORT/!;
+                       s!$tmpdir\b/(?:[^/]+/)?!\$TMPDIR/!g;
+                       s!\Q$PWD\E\b!\$PWD!g;
+               }
        }
        ok(lei(@_), "lei @msg". ($msg ? " ($$msg)" : '')) or diag $lei_err;
 }
@@ -497,25 +523,33 @@ SKIP: {
 Socket::MsgHdr missing or Inline::C is unconfigured/missing
 EOM
        $lei_opt = { 1 => \$lei_out, 2 => \$lei_err };
-       my ($daemon_pid, $for_destroy);
+       my ($daemon_pid, $for_destroy, $daemon_xrd);
        my $tmpdir = $test_opt->{tmpdir};
        ($tmpdir, $for_destroy) = tmpdir unless $tmpdir;
+       state $persist_xrd = $ENV{TEST_LEI_DAEMON_PERSIST_DIR};
        SKIP: {
                skip 'TEST_LEI_ONESHOT set', 1 if $ENV{TEST_LEI_ONESHOT};
                my $home = "$tmpdir/lei-daemon";
                mkdir($home, 0700) or BAIL_OUT "mkdir: $!";
                local $ENV{HOME} = $home;
-               my $xrd = "$home/xdg_run";
-               mkdir($xrd, 0700) or BAIL_OUT "mkdir: $!";
-               local $ENV{XDG_RUNTIME_DIR} = $xrd;
+               my $persist;
+               if ($persist_xrd && !$test_opt->{daemon_only}) {
+                       $persist = $daemon_xrd = $persist_xrd;
+               } else {
+                       $daemon_xrd = "$home/xdg_run";
+                       mkdir($daemon_xrd, 0700) or BAIL_OUT "mkdir: $!";
+               }
+               local $ENV{XDG_RUNTIME_DIR} = $daemon_xrd;
                $cb->();
-               lei_ok(qw(daemon-pid), \"daemon-pid after $t");
-               chomp($daemon_pid = $lei_out);
-               if ($daemon_pid) {
+               unless ($persist) {
+                       lei_ok(qw(daemon-pid), \"daemon-pid after $t");
+                       chomp($daemon_pid = $lei_out);
+                       if (!$daemon_pid) {
+                               fail("daemon not running after $t");
+                               skip 'daemon died unexpectedly', 2;
+                       }
                        ok(kill(0, $daemon_pid), "daemon running after $t");
                        lei_ok(qw(daemon-kill), \"daemon-kill after $t");
-               } else {
-                       fail("daemon not running after $t");
                }
        }; # SKIP for lei_daemon
        unless ($test_opt->{daemon_only}) {
@@ -537,6 +571,11 @@ EOM
                        tick;
                }
                ok(!kill(0, $daemon_pid), "$t daemon stopped after oneshot");
+               my $f = "$daemon_xrd/lei/errors.log";
+               open my $fh, '<', $f or BAIL_OUT "$f: $!";
+               my @l = <$fh>;
+               is_deeply(\@l, [],
+                       "$t daemon XDG_RUNTIME_DIR/lei/errors.log empty");
        }
 }; # SKIP if missing git 2.6+ || Xapian || SQLite || json
 } # /test_lei
@@ -593,13 +632,17 @@ sub create_inbox ($$;@) {
        require PublicInbox::InboxWritable;
        my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
        my $dir = "t/data-gen/$base.$ident";
-       unless (-d $dir) {
+       my $new = !-d $dir;
+       if ($new) {
                mkdir $dir; # may race
                -d $dir or BAIL_OUT "$dir could not be created: $!";
        }
        my $lk = bless { lock_path => "$dir/creat.lock" }, 'PublicInbox::Lock';
        $opt{inboxdir} = File::Spec->rel2abs($dir);
        $opt{name} //= $ident;
+       my $scope = $lk->lock_for_scope;
+       my $pre_cb = delete $opt{pre_cb};
+       $pre_cb->($dir) if $pre_cb && $new;
        $opt{-no_fsync} = 1;
        my $no_gc = delete $opt{-no_gc};
        my $tmpdir = delete $opt{tmpdir};
@@ -608,7 +651,6 @@ sub create_inbox ($$;@) {
        my $parallel = delete($opt{importer_parallel}) // 0;
        my $creat_opt = { nproc => delete($opt{nproc}) // 1 };
        my $ibx = PublicInbox::InboxWritable->new({ %opt }, $creat_opt);
-       my $scope = $lk->lock_for_scope;
        if (!-f "$dir/creat.stamp") {
                my $im = $ibx->importer($parallel);
                $cb->($im, $ibx);
@@ -633,6 +675,31 @@ sub create_inbox ($$;@) {
        $ibx;
 }
 
+sub test_httpd ($$;$) {
+       my ($env, $client, $skip) = @_;
+       for (qw(PI_CONFIG TMPDIR)) {
+               $env->{$_} or BAIL_OUT "$_ unset";
+       }
+       SKIP: {
+               require_mods(qw(Plack::Test::ExternalServer), $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);
+               $td->join('TERM');
+               open my $fh, '<', $err or BAIL_OUT $!;
+               my $e = do { local $/; <$fh> };
+               if ($e =~ s/^Plack::Middleware::ReverseProxy missing,\n//gms) {
+                       $e =~ s/^URL generation for redirects .*\n//gms;
+               }
+               is($e, '', 'no errors');
+       }
+};
+
+
 package PublicInboxTestProcess;
 use strict;