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 Exporter 'import';
  12 our @EXPORT = qw(worker worker_next);
  13
  14 use File::Basename qw(basename);
  15 my @x;
  16 my $options;
  17
  18 sub worker {
  19     my ($display, $x, $outdir, $optref) = @_;
  20
  21     # make sure $x hangs around
  22     push @x, $x;
  23
  24     # store the options hashref
  25     $options = $optref;
  26
  27     socketpair(my $ipc_child, my $ipc, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)
  28         or die "socketpair: $!";
  29
  30     $ipc->autoflush(1);
  31     $ipc_child->autoflush(1);
  32
  33     my $worker = {
  34         display => $display,
  35         ipc => $ipc,
  36     };
  37
  38     my $pid = fork // die "could not fork: $!";
  39
  40     if ($pid == 0) {
  41         close $ipc;
  42         undef @complete_run::CLEANUP;
  43         # reap dead test children
  44         $SIG{CHLD} = sub { waitpid -1, POSIX::WNOHANG };
  45
  46         $worker->{ipc} = $ipc_child;
  47
  48         require i3test;
  49         # TODO: recycle $x
  50         # unfortunately this fails currently with:
  51         # Could not get reply for: xcb_intern_atom_reply at X11/XCB/Atom.pm line 22.
  52
  53         # $i3test::x = bless $x, 'i3test::X11';
  54         worker_wait($worker, $outdir);
  55         exit 23;
  56
  57     }
  58
  59     close $ipc_child;
  60     push @complete_run::CLEANUP, sub {
  61         # signal via empty line to exit itself
  62         syswrite($ipc, "\n") or kill('TERM', $pid);
  63         waitpid $pid, 0;
  64     };
  65
  66     return $worker;
  67
  68 }
  69
  70 our $EOF = "# end of file\n";
  71 sub worker_wait {
  72     my ($self, $outdir) = @_;
  73
  74     my $ipc = $self->{ipc};
  75     my $ipc_fd = fileno($ipc);
  76
  77     while (defined(my $file = $ipc->getline)) {
  78         chomp $file;
  79
  80         exit unless $file;
  81
  82         die "tried to launch nonexistend testfile $file: $!\n"
  83             unless -e $file;
  84
  85         # start a new and self contained process:
  86         # whatever happens in the testfile should *NOT* effect us.
  87
  88         my $pid = fork // die "could not fork: $!";
  89         if ($pid == 0) {
  90             undef @complete_run::CLEANUP;
  91             local $SIG{CHLD};
  92
  93             $0 = $file;
  94
  95             POSIX::dup2($ipc_fd, 0);
  96             POSIX::dup2($ipc_fd, 1);
  97             POSIX::dup2(1, 2);
  98
  99             # get Test::Builder singleton
 100             my $test = Test::Builder->new;
 101
 102             # Test::Builder dups stdout/stderr while loading.
 103             # we need to reset them here to point to $ipc
 104             $test->output(\*STDOUT);
 105             $test->failure_output(\*STDERR);
 106             $test->todo_output(\*STDOUT);
 107
 108             @ENV{qw(DISPLAY TESTNAME OUTDIR VALGRIND STRACE COVERAGE RESTART)}
 109                 = ($self->{display},
 110                    basename($file),
 111                    $outdir,
 112                    $options->{valgrind},
 113                    $options->{strace},
 114                    $options->{coverage},
 115                    $options->{restart});
 116
 117             package main;
 118             local $@;
 119             do "./$file";
 120             $test->ok(undef, "$@") if $@;
 121
 122             # XXX hack, we need to trigger the read watcher once more
 123             # to signal eof to TAP::Parser
 124             print $EOF;
 125
 126             exit 0;
 127         }
 128     }
 129 }
 130
 131 sub worker_next {
 132     my ($self, $file) = @_;
 133
 134     my $ipc = $self->{ipc};
 135     syswrite $ipc, "$file\n" or die "syswrite: $!";
 136 }
 137
 138 __PACKAGE__ __END__