2 # vim:ts=4:sw=4:expandtab
7 use Time::HiRes qw(sleep);
10 our @EXPORT = qw(start_xdummy);
13 my $x_socketpath = '/tmp/.X11-unix/X';
15 # reads in a whole file
17 open(my $fh, '<', shift) or return '';
22 # forks an Xdummy or Xdmx process
24 my $keep_xdummy_output = shift;
25 my $displaynum = shift;
27 die "Could not fork: $!" unless defined($pid);
29 # Child, close stdout/stderr, then start Xdummy.
30 if (!$keep_xdummy_output) {
38 push(@complete_run::CLEANUP, sub {
40 # Unlink the X11 socket, Xdmx seems to leave it there.
41 unlink($x_socketpath . $displaynum);
46 return $x_socketpath . $displaynum;
49 # Blocks until the socket paths specified in the given array reference actually
52 my ($sockets_waiting) = @_;
54 # Wait until Xdmx actually runs. Pretty ugly solution, but as long as we
55 # can’t socket-activate X11…
57 @$sockets_waiting = grep { ! -S $_ } @$sockets_waiting;
58 last unless @$sockets_waiting;
63 =head2 start_xdummy($parallel)
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.
72 my ($parallel, $numtests, $keep_xdummy_output) = @_;
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";
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";
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.
96 # If unset, we use num_cores * 2.
97 $parallel ||= ($num_cores * 2);
99 # If we are running a small number of tests, don’t over-parallelize.
100 $parallel = $numtests if $numtests < $parallel;
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 . '*');
107 say "Starting $parallel Xdummy instances, starting at :$displaynum...";
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',
117 push(@displays, ":$displaynum");
118 push(@sockets_waiting, $socket);
122 wait_for_x(\@sockets_waiting);