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         require i3test;
  51         # TODO: recycle $x
  52         # unfortunately this fails currently with:
  53         # Could not get reply for: xcb_intern_atom_reply at X11/XCB/Atom.pm line 22.
  54
  55         # $i3test::x = bless $x, 'i3test::X11';
  56         worker_wait($worker, $outdir);
  57         exit 23;
  58
  59     }
  60
  61     close $ipc_child;
  62     push @complete_run::CLEANUP, sub {
  63         # signal via empty line to exit itself
  64         syswrite($ipc, "\n") or kill('TERM', $pid);
  65         waitpid $pid, 0;
  66     };
  67
  68     return $worker;
  69
  70 }
  71
  72 our $EOF = "# end of file\n";
  73 sub worker_wait {
  74     my ($self, $outdir) = @_;
  75
  76     my $ipc = $self->{ipc};
  77     my $ipc_fd = fileno($ipc);
  78
  79     while (1) {
  80         my $file = $ipc->getline;
  81         if (!defined($file)) {
  82             next if $! == EAGAIN;
  83             last;
  84         }
  85         chomp $file;
  86
  87         exit unless $file;
  88
  89         die "tried to launch nonexistend testfile $file: $!\n"
  90             unless -e $file;
  91
  92         # start a new and self contained process:
  93         # whatever happens in the testfile should *NOT* effect us.
  94
  95         my $pid = fork // die "could not fork: $!";
  96         if ($pid == 0) {
  97             undef @complete_run::CLEANUP;
  98             local $SIG{CHLD};
  99
 100             $0 = $file;
 101
 102             # Re-seed rand() so that File::Temp’s tempnam produces different
 103             # results, making a TOCTOU between e.g. t/175-startup-notification.t
 104             # and t/180-fd-leaks.t less likely.
 105             srand(time ^ $$);
 106
 107             POSIX::dup2($ipc_fd, 0);
 108             POSIX::dup2($ipc_fd, 1);
 109             POSIX::dup2(1, 2);
 110
 111             # get Test::Builder singleton
 112             my $test = Test::Builder->new;
 113
 114             # Test::Builder dups stdout/stderr while loading.
 115             # we need to reset them here to point to $ipc
 116             $test->output(\*STDOUT);
 117             $test->failure_output(\*STDERR);
 118             $test->todo_output(\*STDOUT);
 119
 120             @ENV{qw(HOME DISPLAY TESTNAME OUTDIR VALGRIND STRACE XTRACE COVERAGE RESTART)}
 121                 = ($outdir,
 122                    $self->{display},
 123                    basename($file),
 124                    $outdir,
 125                    $options->{valgrind},
 126                    $options->{strace},
 127                    $options->{xtrace},
 128                    $options->{coverage},
 129                    $options->{restart});
 130
 131             package main;
 132             local $@;
 133             do $file;
 134             $test->ok(undef, "$@") if $@;
 135
 136             # XXX hack, we need to trigger the read watcher once more
 137             # to signal eof to TAP::Parser
 138             print $EOF;
 139
 140             exit 0;
 141         }
 142     }
 143 }
 144
 145 sub worker_next {
 146     my ($self, $file) = @_;
 147
 148     my $ipc = $self->{ipc};
 149     syswrite $ipc, "$file\n" or die "syswrite: $!";
 150 }
 151
 152 __PACKAGE__ __END__