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             POSIX::dup2($ipc_fd, 0);
 103             POSIX::dup2($ipc_fd, 1);
 104             POSIX::dup2(1, 2);
 105
 106             # get Test::Builder singleton
 107             my $test = Test::Builder->new;
 108
 109             # Test::Builder dups stdout/stderr while loading.
 110             # we need to reset them here to point to $ipc
 111             $test->output(\*STDOUT);
 112             $test->failure_output(\*STDERR);
 113             $test->todo_output(\*STDOUT);
 114
 115             @ENV{qw(HOME DISPLAY TESTNAME OUTDIR VALGRIND STRACE XTRACE COVERAGE RESTART)}
 116                 = ($outdir,
 117                    $self->{display},
 118                    basename($file),
 119                    $outdir,
 120                    $options->{valgrind},
 121                    $options->{strace},
 122                    $options->{xtrace},
 123                    $options->{coverage},
 124                    $options->{restart});
 125
 126             package main;
 127             local $@;
 128             do $file;
 129             $test->ok(undef, "$@") if $@;
 130
 131             # XXX hack, we need to trigger the read watcher once more
 132             # to signal eof to TAP::Parser
 133             print $EOF;
 134
 135             exit 0;
 136         }
 137     }
 138 }
 139
 140 sub worker_next {
 141     my ($self, $file) = @_;
 142
 143     my $ipc = $self->{ipc};
 144     syswrite $ipc, "$file\n" or die "syswrite: $!";
 145 }
 146
 147 __PACKAGE__ __END__