tests: use File::Temp->newdir instead of tempdir()

[public-inbox.git] / t / nntpd-validate.t

diff --git a/t/nntpd-validate.t b/t/nntpd-validate.t
index 1a325105cb5a7f789cf5a6d5068f860c0a9b72fc..39108639ab9edfe793c5b9de7d7546c926544299 100644 (file)
--- a/t/nntpd-validate.t
+++ b/t/nntpd-validate.t
@@ -4,19 +4,14 @@
 # Integration test to validate compression.
 use strict;
 use warnings;
-use File::Temp qw(tempdir);
 use Test::More;
 use Symbol qw(gensym);
 use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
+use POSIX qw(_exit);
 my $inbox_dir = $ENV{GIANT_INBOX_DIR};
 plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inbox_dir;
 my $mid = $ENV{TEST_MID};
 
-# This test is also an excuse for me to experiment with Perl threads :P
-unless (eval 'use threads; 1') {
-       plan skip_all => "$0 requires a threaded perl" if $@;
-}
-
 # Net::NNTP is part of the standard library, but distros may split it off...
 foreach my $mod (qw(DBD::SQLite Net::NNTP Compress::Raw::Zlib)) {
        eval "require $mod";
@@ -32,18 +27,13 @@ my $test_tls = $ENV{TEST_SKIP_TLS} ? 0 : eval { require IO::Socket::SSL };
 my $cert = 'certs/server-cert.pem';
 my $key = 'certs/server-key.pem';
 if ($test_tls && !-r $key || !-r $cert) {
-       plan skip_all => "certs/ missing for $0, run ./certs/create-certs.perl";
+       plan skip_all => "certs/ missing for $0, run $^X ./certs/create-certs.perl";
 }
 require './t/common.perl';
-my $keep_tmp = !!$ENV{TEST_KEEP_TMP};
-my $tmpdir = tempdir('nntpd-validate-XXXXXX',TMPDIR => 1,CLEANUP => $keep_tmp);
-my (%OPT, $pid, $tail_pid, $host_port, $group);
+my ($tmpdir, $ftd) = tmpdir();
+$File::Temp::KEEP_ALL = !!$ENV{TEST_KEEP_TMP};
+my (%OPT, $td, $host_port, $group);
 my $batch = 1000;
-END {
-       foreach ($pid, $tail_pid) {
-               kill 'TERM', $_ if defined $_;
-       }
-};
 if (($ENV{NNTP_TEST_URL} // '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) {
        ($host_port, $group) = ($1, $2);
        $host_port .= ":119" unless index($host_port, ':') > 0;
@@ -72,7 +62,7 @@ sub do_get_all {
        my $dig = Digest::SHA->new(1);
        my $digfh = gensym;
        my $tmpfh;
-       if ($keep_tmp) {
+       if ($File::Temp::KEEP_ALL) {
                open $tmpfh, '>', "$tmpdir/$desc.raw" or die $!;
        }
        my $tmp = { dig => $dig, tmpfh => $tmpfh };
@@ -112,11 +102,17 @@ sub do_get_all {
                        }
                }
        }
+
+       # hacky bytes_read thing added to Net::NNTP for testing:
+       my $bytes_read = '';
+       if ($nntp->can('bytes_read')) {
+               $bytes_read .= ' '.$nntp->bytes_read.'b';
+       }
        my $q = $nntp->quit;
        print STDERR "# quit failed: ".$nntp->code."\n" if !$q;
        my $elapsed = sprintf('%0.3f', clock_gettime(CLOCK_MONOTONIC) - $t0);
        my $res = $dig->hexdigest;
-       print STDERR "# $desc - $res (${elapsed}s)\n";
+       print STDERR "# $desc - $res (${elapsed}s)$bytes_read\n";
        $res;
 }
 my @tests = ([]);
@@ -127,11 +123,29 @@ my (@keys, %thr, %res);
 for my $m (@tests) {
        my $key = join(',', @$m);
        push @keys, $key;
-       diag "$key start";
-       $thr{$key} = threads->create(\&do_get_all, $m);
+       pipe(my ($r, $w)) or die;
+       my $pid = fork;
+       if ($pid == 0) {
+               close $r or die;
+               my $res = do_get_all($m);
+               print $w $res or die;
+               $w->flush;
+               _exit(0);
+       }
+       close $w or die;
+       $thr{$key} = [ $pid, $r ];
+}
+for my $key (@keys) {
+       my ($pid, $r) = @{delete $thr{$key}};
+       local $/;
+       $res{$key} = <$r>;
+       defined $res{$key} or die "nothing for $key";
+       my $w = waitpid($pid, 0);
+       defined($w) or die;
+       $w == $pid or die "waitpid($pid) != $w)";
+       is($?, 0, "`$key' exited successfully")
 }
 
-$res{$_} = $thr{$_}->join for @keys;
 my $plain = $res{''};
 ok($plain, "plain got $plain");
 is($res{$_}, $plain, "$_ matches '' result") for @keys;
@@ -141,16 +155,15 @@ done_testing();
 sub make_local_server {
        require PublicInbox::Inbox;
        $group = 'inbox.test.perf.nntpd';
-       my $ibx = { mainrepo => $inbox_dir, newsgroup => $group };
+       my $ibx = { inboxdir => $inbox_dir, newsgroup => $group };
        $ibx = PublicInbox::Inbox->new($ibx);
-       my $nntpd = 'blib/script/public-inbox-nntpd';
        my $pi_config = "$tmpdir/config";
        {
                open my $fh, '>', $pi_config or die "open($pi_config): $!";
                print $fh <<"" or die "print $pi_config: $!";
 [publicinbox "test"]
        newsgroup = $group
-       mainrepo = $inbox_dir
+       inboxdir = $inbox_dir
        address = test\@example.com
 
                close $fh or die "close($pi_config): $!";
@@ -159,20 +172,13 @@ sub make_local_server {
        for ($out, $err) {
                open my $fh, '>', $_ or die "truncate: $!";
        }
-       if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail
-               $tail_pid = fork;
-               if (defined $tail_pid && $tail_pid == 0) {
-                       open STDOUT, '>&STDERR' or die ">&2 failed: $!";
-                       exec(split(' ', $tail_cmd), $out, $err);
-               }
-       }
        my $sock = tcp_server();
        ok($sock, 'sock created');
        $host_port = $sock->sockhost . ':' . $sock->sockport;
 
        # not using multiple workers, here, since we want to increase
        # the chance of tripping concurrency bugs within PublicInbox/NNTP*.pm
-       my $cmd = [ $nntpd, "--stdout=$out", "--stderr=$err", '-W0' ];
+       my $cmd = [ '-nntpd', "--stdout=$out", "--stderr=$err", '-W0' ];
        push @$cmd, "-lnntp://$host_port";
        if ($test_tls) {
                push @$cmd, "--cert=$cert", "--key=$key";
@@ -184,7 +190,8 @@ sub make_local_server {
                );
        }
        print STDERR "# CMD ". join(' ', @$cmd). "\n";
-       $pid = spawn_listener({ PI_CONFIG => $pi_config }, $cmd, [$sock]);
+       my $env = { PI_CONFIG => $pi_config };
+       $td = start_script($cmd, $env, { 3 => $sock });
 }
 
 package DigestPipe;