]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/TestCommon.pm
imap+nntp: share COMPRESS implementation
[public-inbox.git] / lib / PublicInbox / TestCommon.pm
index aff34853a88886180849fb35412534ea417f08ca..ecf7a261b6f485447dce78ca6f10fd74660f4201 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) 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
@@ -12,13 +12,15 @@ use IO::Socket::INET;
 use File::Spec;
 our @EXPORT;
 my $lei_loud = $ENV{TEST_LEI_ERR_LOUD};
+my $tail_cmd = $ENV{TAIL};
 our ($lei_opt, $lei_out, $lei_err, $lei_cwdfh);
 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
-               test_httpd xbail require_cmd is_xdeeply);
+               test_httpd xbail require_cmd is_xdeeply tail_f
+               ignore_inline_c_missing);
        require Test::More;
        my @methods = grep(!/\W/, @Test::More::EXPORT);
        eval(join('', map { "*$_=\\&Test::More::$_;" } @methods));
@@ -280,11 +282,20 @@ sub run_script ($;$$) {
        my $sub = $run_mode == 0 ? undef : key2sub($key);
        my $fhref = [];
        my $spawn_opt = {};
+       my @tail_paths;
        for my $fd (0..2) {
                my $redir = $opt->{$fd};
                my $ref = ref($redir);
                if ($ref eq 'SCALAR') {
-                       open my $fh, '+>', undef or die "open: $!";
+                       my $fh;
+                       if ($tail_cmd && $ENV{TAIL_ALL} && $fd > 0) {
+                               require File::Temp;
+                               $fh = File::Temp->new("fd.$fd-XXXX", TMPDIR=>1);
+                               push @tail_paths, $fh->filename;
+                       } else {
+                               open $fh, '+>', undef;
+                       }
+                       $fh or xbail $!;
                        $fhref->[$fd] = $fh;
                        $spawn_opt->{$fd} = $fh;
                        next if $fd > 0;
@@ -297,6 +308,7 @@ sub run_script ($;$$) {
                        die "unable to deal with $ref $redir";
                }
        }
+       my $tail = @tail_paths ? tail_f(@tail_paths) : undef;
        if ($key =~ /-(index|convert|extindex|convert|xcpdb)\z/) {
                unshift @argv, '--no-fsync';
        }
@@ -337,6 +349,7 @@ sub run_script ($;$$) {
                umask($umask);
        }
 
+       { local $?; undef $tail };
        # slurp the redirects back into user-supplied strings
        for my $fd (1..2) {
                my $fh = $fhref->[$fd] or next;
@@ -355,17 +368,17 @@ sub tick (;$) {
        1;
 }
 
-sub wait_for_tail ($;$) {
+sub wait_for_tail {
        my ($tail_pid, $want) = @_;
-       my $wait = 2;
+       my $wait = 2; # "tail -F" sleeps 1.0s at-a-time w/o inotify/kevent
        if ($^O eq 'linux') { # GNU tail may use inotify
                state $tail_has_inotify;
-               return tick if $want < 0 && $tail_has_inotify;
-               my $end = time + $wait;
+               return tick if !$want && $tail_has_inotify; # before TERM
+               my $end = time + $wait; # wait for startup:
                my @ino;
                do {
                        @ino = grep {
-                               readlink($_) =~ /\binotify\b/
+                               (readlink($_) // '') =~ /\binotify\b/
                        } glob("/proc/$tail_pid/fd/*");
                } while (!@ino && time <= $end and tick);
                return if !@ino;
@@ -410,13 +423,24 @@ sub xqx {
        wantarray ? split(/^/m, $out) : $out;
 }
 
+sub tail_f (@) {
+       $tail_cmd or return; # "tail -F" or "tail -f"
+       for (@_) { open(my $fh, '>>', $_) or die $! };
+       my $cmd = [ split(/ /, $tail_cmd), @_ ];
+       require PublicInbox::Spawn;
+       my $pid = PublicInbox::Spawn::spawn($cmd, undef, { 1 => 2 });
+       wait_for_tail($pid, scalar @_);
+       require PublicInbox::AutoReap;
+       PublicInbox::AutoReap->new($pid, \&wait_for_tail);
+}
+
 sub start_script {
        my ($cmd, $env, $opt) = @_;
        my ($key, @argv) = @$cmd;
        my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 2;
        my $sub = $run_mode == 0 ? undef : key2sub($key);
-       my $tail_pid;
-       if (my $tail_cmd = $ENV{TAIL}) {
+       my $tail;
+       if ($tail_cmd) {
                my @paths;
                for (@argv) {
                        next unless /\A--std(?:err|out)=(.+)\z/;
@@ -434,17 +458,7 @@ sub start_script {
                                }
                        }
                }
-               if (@paths) {
-                       $tail_pid = fork // die "fork: $!";
-                       if ($tail_pid == 0) {
-                               # make sure files exist, first
-                               open my $fh, '>>', $_ for @paths;
-                               open(STDOUT, '>&STDERR') or die "1>&2: $!";
-                               exec(split(' ', $tail_cmd), @paths);
-                               die "$tail_cmd failed: $!";
-                       }
-                       wait_for_tail($tail_pid, scalar @paths);
-               }
+               $tail = tail_f(@paths);
        }
        my $pid = fork // die "fork: $!\n";
        if ($pid == 0) {
@@ -469,6 +483,7 @@ sub start_script {
                        $ENV{LISTEN_PID} = $$;
                        $ENV{LISTEN_FDS} = $fds;
                }
+               if ($opt->{-C}) { chdir($opt->{-C}) or die "chdir: $!" }
                $0 = join(' ', @$cmd);
                if ($sub) {
                        eval { PublicInbox::DS->Reset };
@@ -479,7 +494,10 @@ sub start_script {
                        die "FAIL: ",join(' ', $key, @argv), ": $!\n";
                }
        }
-       PublicInboxTestProcess->new($pid, $tail_pid);
+       require PublicInbox::AutoReap;
+       my $td = PublicInbox::AutoReap->new($pid);
+       $td->{-extra} = $tail;
+       $td;
 }
 
 # favor lei() or lei_ok() over $lei for new code
@@ -530,6 +548,11 @@ sub is_xdeeply ($$$) {
        $ok;
 }
 
+sub ignore_inline_c_missing {
+       $_[0] = join('', grep(/\S/, grep(!/compilation aborted/,
+               grep(!/\bInline\b/, split(/^/m, $_[0])))));
+}
+
 sub test_lei {
 SKIP: {
        my ($cb) = pop @_;
@@ -539,18 +562,25 @@ SKIP: {
        require_git(2.6, 1) or skip('git 2.6+ required for lei test', 2);
        my $mods = $test_opt->{mods} // [ 'lei' ];
        require_mods(@$mods, 2);
+
+       # set PERL_INLINE_DIRECTORY before clobbering XDG_CACHE_HOME
+       require PublicInbox::Spawn;
        require PublicInbox::Config;
        require File::Path;
+
        local %ENV = %ENV;
        delete $ENV{XDG_DATA_HOME};
        delete $ENV{XDG_CONFIG_HOME};
+       delete $ENV{XDG_CACHE_HOME};
        $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com';
        $ENV{GIT_COMMITTER_NAME} = 'lei user';
+       $ENV{LANG} = $ENV{LC_ALL} = 'C';
        my (undef, $fn, $lineno) = caller(0);
        my $t = "$fn:$lineno";
-       require PublicInbox::Spawn;
-       state $lei_daemon = PublicInbox::Spawn->can('send_cmd4') ||
-                               eval { require Socket::MsgHdr; 1 };
+       state $lei_daemon = PublicInbox::Spawn->can('send_cmd4') || do {
+                       require PublicInbox::Syscall;
+                       PublicInbox::Syscall->can('send_cmd4');
+               } || eval { require Socket::MsgHdr; 1 };
        unless ($lei_daemon) {
                skip('Inline::C unconfigured/missing '.
 '(mkdir -p ~/.cache/public-inbox/inline-c) OR Socket::MsgHdr missing',
@@ -657,8 +687,10 @@ sub create_inbox ($$;@) {
        my %opt = @_;
        require PublicInbox::Lock;
        require PublicInbox::InboxWritable;
+       require PublicInbox::Import;
        my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
-       my $dir = "t/data-gen/$base.$ident";
+       my ($db) = (PublicInbox::Import::default_branch() =~ m!([^/]+)\z!);
+       my $dir = "t/data-gen/$base.$ident-$db";
        my $new = !-d $dir;
        if ($new) {
                mkdir $dir; # may race
@@ -727,40 +759,6 @@ sub test_httpd ($$;$) {
 };
 
 
-package PublicInboxTestProcess;
-use strict;
-
-# prevent new threads from inheriting these objects
-sub CLONE_SKIP { 1 }
-
-sub new {
-       my ($klass, $pid, $tail_pid) = @_;
-       bless { pid => $pid, tail_pid => $tail_pid, owner => $$ }, $klass;
-}
-
-sub kill {
-       my ($self, $sig) = @_;
-       CORE::kill($sig // 'TERM', $self->{pid});
-}
-
-sub join {
-       my ($self, $sig) = @_;
-       my $pid = delete $self->{pid} or return;
-       CORE::kill($sig, $pid) if defined $sig;
-       my $ret = waitpid($pid, 0) // die "waitpid($pid): $!";
-       $ret == $pid or die "waitpid($pid) != $ret";
-}
-
-sub DESTROY {
-       my ($self) = @_;
-       return if $self->{owner} != $$;
-       if (my $tail_pid = delete $self->{tail_pid}) {
-               PublicInbox::TestCommon::wait_for_tail($tail_pid, -1);
-               CORE::kill('TERM', $tail_pid);
-       }
-       $self->join('TERM');
-}
-
 package PublicInbox::TestCommon::InboxWakeup;
 use strict;
 sub on_inbox_unlock { ${$_[0]}->($_[1]) }