2 # vim:ts=4:sw=4:expandtab
7 use Time::HiRes qw(sleep);
10 our @EXPORT = qw(start_xdummy);
12 # reads in a whole file
14 open(my $fh, '<', shift) or return '';
19 =head2 start_xdummy($parallel)
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.
27 my $x_socketpath = '/tmp/.X11-unix/X';
30 my ($parallel, $numtests) = @_;
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.
42 $parallel ||= $num_cores * 2;
44 # If we are running a small number of tests, don’t over-parallelize.
45 $parallel = $numtests if $numtests < $parallel;
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 . '*');
52 say "Starting $parallel Xdummy instances, starting at :$displaynum...";
55 for my $idx (0 .. ($parallel-1)) {
57 die "Could not fork: $!" unless defined($pid);
59 # Child, close stdout/stderr, then start Xdummy.
62 # make sure this display isn’t in use yet
63 $displaynum++ while -e ($x_socketpath . $displaynum);
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';
71 push(@complete_run::CLEANUP, sub { kill(15, $pid) });
72 push(@displays, ":$displaynum");
73 push(@sockets_waiting, $x_socketpath . $displaynum);
77 # Wait until the X11 sockets actually appear. Pretty ugly solution, but as
78 # long as we can’t socket-activate X11…
80 @sockets_waiting = grep { ! -S $_ } @sockets_waiting;
81 last unless @sockets_waiting;