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