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

   1 package StartXDummy;
   2 # vim:ts=4:sw=4:expandtab
   3
   4 use strict;
   5 use warnings;
   6 use Exporter 'import';
   7 use Time::HiRes qw(sleep);
   8 use v5.10;
   9
  10 our @EXPORT = qw(start_xdummy);
  11
  12 my @pids;
  13 my $x_socketpath = '/tmp/.X11-unix/X';
  14
  15 # reads in a whole file
  16 sub slurp {
  17     open(my $fh, '<', shift) or return '';
  18     local $/;
  19     <$fh>;
  20 }
  21
  22 # forks an Xdummy or Xdmx process
  23 sub fork_xserver {
  24     my $keep_xdummy_output = shift;
  25     my $displaynum = shift;
  26     my $pid = fork();
  27     die "Could not fork: $!" unless defined($pid);
  28     if ($pid == 0) {
  29         # Child, close stdout/stderr, then start Xdummy.
  30         if (!$keep_xdummy_output) {
  31             close STDOUT;
  32             close STDERR;
  33         }
  34
  35         exec @_;
  36         exit 1;
  37     }
  38     push(@complete_run::CLEANUP, sub {
  39         kill(15, $pid);
  40         # Unlink the X11 socket, Xdmx seems to leave it there.
  41         unlink($x_socketpath . $displaynum);
  42     });
  43
  44     push @pids, $pid;
  45
  46     return $x_socketpath . $displaynum;
  47 }
  48
  49 # Blocks until the socket paths specified in the given array reference actually
  50 # exist.
  51 sub wait_for_x {
  52     my ($sockets_waiting) = @_;
  53
  54     # Wait until Xdmx actually runs. Pretty ugly solution, but as long as we
  55     # can’t socket-activate X11…
  56     while (1) {
  57         @$sockets_waiting = grep { ! -S $_ } @$sockets_waiting;
  58         last unless @$sockets_waiting;
  59         sleep 0.1;
  60     }
  61 }
  62
  63 =head2 start_xdummy($parallel)
  64
  65 Starts C<$parallel> (or number of cores * 2 if undef) Xdummy processes (see
  66 the file ./Xdummy) and returns two arrayrefs: a list of X11 display numbers to
  67 the Xdummy processes and a list of PIDs of the processes.
  68
  69 =cut
  70
  71 sub start_xdummy {
  72     my ($parallel, $numtests, $keep_xdummy_output) = @_;
  73
  74     my @displays = ();
  75     my @childpids = ();
  76
  77     $SIG{CHLD} = sub {
  78         my $child = waitpid -1, POSIX::WNOHANG;
  79         @pids = grep { $_ != $child } @pids;
  80         return unless @pids == 0;
  81         print STDERR "All Xdummy processes died.\n";
  82         print STDERR "Use ./complete-run.pl --parallel 1 --keep-xdummy-output\n";
  83         print STDERR "";
  84         print STDERR "A frequent cause for this is missing the DUMMY Xorg module,\n";
  85         print STDERR "package xserver-xorg-video-dummy on Debian.\n";
  86         exit 1;
  87     };
  88
  89     # Yeah, I know it’s non-standard, but Perl’s POSIX module doesn’t have
  90     # _SC_NPROCESSORS_CONF.
  91     my $cpuinfo = slurp('/proc/cpuinfo');
  92     my $num_cores = scalar grep { /model name/ } split("\n", $cpuinfo);
  93     # If /proc/cpuinfo does not exist, we fall back to 2 cores.
  94     $num_cores ||= 2;
  95
  96     # If unset, we use num_cores * 2.
  97     $parallel ||= ($num_cores * 2);
  98
  99     # If we are running a small number of tests, don’t over-parallelize.
 100     $parallel = $numtests if $numtests < $parallel;
 101
 102     # First get the last used display number, then increment it by one.
 103     # Effectively falls back to 1 if no X server is running.
 104     my ($displaynum) = map { /(\d+)$/ } reverse sort glob($x_socketpath . '*');
 105     $displaynum++;
 106
 107     say "Starting $parallel Xdummy instances, starting at :$displaynum...";
 108
 109     my @sockets_waiting;
 110     for (1 .. $parallel) {
 111         # We use -config /dev/null to prevent Xdummy from using the system
 112         # Xorg configuration. The tests should be independant from the
 113         # actual system X configuration.
 114         my $socket = fork_xserver($keep_xdummy_output, $displaynum,
 115                 './Xdummy', ":$displaynum", '-config', '/dev/null',
 116                 '-nolisten', 'tcp');
 117         push(@displays, ":$displaynum");
 118         push(@sockets_waiting, $socket);
 119         $displaynum++;
 120     }
 121
 122     wait_for_x(\@sockets_waiting);
 123
 124     return @displays;
 125 }
 126
 127 1