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