git.sur5r.net Git - i3/i3/blob - testcases/lib/TestWorker.pm

   1 # vim:ts=4:sw=4:sts=4:expandtab
   2 package TestWorker;
   3 use strict; use warnings;
   4 use v5.10;
   5
   6 use Socket qw(AF_UNIX SOCK_DGRAM PF_UNSPEC);
   7 use IO::Handle; # for ->autoflush
   8
   9 use POSIX ();
  10
  11 use Errno qw(EAGAIN);
  12
  13 use Exporter 'import';
  14 our @EXPORT = qw(worker worker_next);
  15
  16 use File::Basename qw(basename);
  17 my @x;
  18 my $options;
  19
  20 sub worker {
  21     my ($display, $x, $outdir, $optref) = @_;
  22
  23     # make sure $x hangs around
  24     push @x, $x;
  25
  26     # store the options hashref
  27     $options = $optref;
  28
  29     socketpair(my $ipc_child, my $ipc, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)
  30         or die "socketpair: $!";
  31
  32     $ipc->autoflush(1);
  33     $ipc_child->autoflush(1);
  34
  35     my $worker = {
  36         display => $display,
  37         ipc => $ipc,
  38     };
  39
  40     my $pid = fork // die "could not fork: $!";
  41
  42     if ($pid == 0) {
  43         close $ipc;
  44         undef @complete_run::CLEANUP;
  45         # reap dead test children
  46         $SIG{CHLD} = sub { waitpid -1, POSIX::WNOHANG };
  47
  48         $worker->{ipc} = $ipc_child;
  49
  50         # Preload the i3test module: reduces user CPU from 25s to 18s
  51         require i3test;
  52
  53         worker_wait($worker, $outdir);
  54         exit 23;
  55
  56     }
  57
  58     close $ipc_child;
  59     push @complete_run::CLEANUP, sub {
  60         # signal via empty line to exit itself
  61         syswrite($ipc, "\n") or kill('TERM', $pid);
  62         waitpid $pid, 0;
  63     };
  64
  65     return $worker;
  66
  67 }
  68
  69 our $EOF = "# end of file\n";
  70 sub worker_wait {
  71     my ($self, $outdir) = @_;
  72
  73     my $ipc = $self->{ipc};
  74     my $ipc_fd = fileno($ipc);
  75
  76     while (1) {
  77         my $file = $ipc->getline;
  78         if (!defined($file)) {
  79             next if $! == EAGAIN;
  80             last;
  81         }
  82         chomp $file;
  83
  84         exit unless $file;
  85
  86         die "tried to launch nonexistent testfile $file: $!\n"
  87             unless -e $file;
  88
  89         # start a new and self contained process:
  90         # whatever happens in the testfile should *NOT* affect us.
  91
  92         my $pid = fork // die "could not fork: $!";
  93         if ($pid == 0) {
  94             undef @complete_run::CLEANUP;
  95             local $SIG{CHLD};
  96
  97             $0 = $file;
  98
  99             # Re-seed rand() so that File::Temp’s tempnam produces different
 100             # results, making a TOCTOU between e.g. t/175-startup-notification.t
 101             # and t/180-fd-leaks.t less likely.
 102             srand(time ^ $$);
 103
 104             POSIX::dup2($ipc_fd, 0);
 105             POSIX::dup2($ipc_fd, 1);
 106             POSIX::dup2(1, 2);
 107
 108             # get Test::Builder singleton
 109             my $test = Test::Builder->new;
 110
 111             # Test::Builder dups stdout/stderr while loading.
 112             # we need to reset them here to point to $ipc
 113             $test->output(\*STDOUT);
 114             $test->failure_output(\*STDERR);
 115             $test->todo_output(\*STDOUT);
 116
 117             @ENV{qw(HOME DISPLAY TESTNAME OUTDIR VALGRIND STRACE XTRACE COVERAGE RESTART)}
 118                 = ($outdir,
 119                    $self->{display},
 120                    basename($file),
 121                    $outdir,
 122                    $options->{valgrind},
 123                    $options->{strace},
 124                    $options->{xtrace},
 125                    $options->{coverage},
 126                    $options->{restart});
 127
 128             package main;
 129             local $@;
 130             do $file;
 131             $test->ok(undef, "$@") if $@;
 132
 133             # XXX hack, we need to trigger the read watcher once more
 134             # to signal eof to TAP::Parser
 135             print $EOF;
 136
 137             exit 0;
 138         }
 139     }
 140 }
 141
 142 sub worker_next {
 143     my ($self, $file) = @_;
 144
 145     my $ipc = $self->{ipc};
 146     syswrite $ipc, "$file\n" or die "syswrite: $!";
 147 }
 148
 149 __PACKAGE__ __END__