889d0abe8f
We add $HOME to the environment variables we define for a test case in order to redirect it from the user's actual home directory. This is necessary because xcb-util-xrm will fall back to $HOME/.Xresources when determining the DPI. If a user has this set to, e.g., 192 on their machine, this would break tests. Since tests shouldn't rely on the system they run in, we redirect the home directory altogether to simulate a clean slate. relates to #2465
148 lines
3.4 KiB
Perl
148 lines
3.4 KiB
Perl
# vim:ts=4:sw=4:sts=4:expandtab
|
|
package TestWorker;
|
|
use strict; use warnings;
|
|
use v5.10;
|
|
|
|
use Socket qw(AF_UNIX SOCK_DGRAM PF_UNSPEC);
|
|
use IO::Handle; # for ->autoflush
|
|
|
|
use POSIX ();
|
|
|
|
use Errno qw(EAGAIN);
|
|
|
|
use Exporter 'import';
|
|
our @EXPORT = qw(worker worker_next);
|
|
|
|
use File::Basename qw(basename);
|
|
my @x;
|
|
my $options;
|
|
|
|
sub worker {
|
|
my ($display, $x, $outdir, $optref) = @_;
|
|
|
|
# make sure $x hangs around
|
|
push @x, $x;
|
|
|
|
# store the options hashref
|
|
$options = $optref;
|
|
|
|
socketpair(my $ipc_child, my $ipc, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)
|
|
or die "socketpair: $!";
|
|
|
|
$ipc->autoflush(1);
|
|
$ipc_child->autoflush(1);
|
|
|
|
my $worker = {
|
|
display => $display,
|
|
ipc => $ipc,
|
|
};
|
|
|
|
my $pid = fork // die "could not fork: $!";
|
|
|
|
if ($pid == 0) {
|
|
close $ipc;
|
|
undef @complete_run::CLEANUP;
|
|
# reap dead test children
|
|
$SIG{CHLD} = sub { waitpid -1, POSIX::WNOHANG };
|
|
|
|
$worker->{ipc} = $ipc_child;
|
|
|
|
require i3test;
|
|
# TODO: recycle $x
|
|
# unfortunately this fails currently with:
|
|
# Could not get reply for: xcb_intern_atom_reply at X11/XCB/Atom.pm line 22.
|
|
|
|
# $i3test::x = bless $x, 'i3test::X11';
|
|
worker_wait($worker, $outdir);
|
|
exit 23;
|
|
|
|
}
|
|
|
|
close $ipc_child;
|
|
push @complete_run::CLEANUP, sub {
|
|
# signal via empty line to exit itself
|
|
syswrite($ipc, "\n") or kill('TERM', $pid);
|
|
waitpid $pid, 0;
|
|
};
|
|
|
|
return $worker;
|
|
|
|
}
|
|
|
|
our $EOF = "# end of file\n";
|
|
sub worker_wait {
|
|
my ($self, $outdir) = @_;
|
|
|
|
my $ipc = $self->{ipc};
|
|
my $ipc_fd = fileno($ipc);
|
|
|
|
while (1) {
|
|
my $file = $ipc->getline;
|
|
if (!defined($file)) {
|
|
next if $! == EAGAIN;
|
|
last;
|
|
}
|
|
chomp $file;
|
|
|
|
exit unless $file;
|
|
|
|
die "tried to launch nonexistend testfile $file: $!\n"
|
|
unless -e $file;
|
|
|
|
# start a new and self contained process:
|
|
# whatever happens in the testfile should *NOT* effect us.
|
|
|
|
my $pid = fork // die "could not fork: $!";
|
|
if ($pid == 0) {
|
|
undef @complete_run::CLEANUP;
|
|
local $SIG{CHLD};
|
|
|
|
$0 = $file;
|
|
|
|
POSIX::dup2($ipc_fd, 0);
|
|
POSIX::dup2($ipc_fd, 1);
|
|
POSIX::dup2(1, 2);
|
|
|
|
# get Test::Builder singleton
|
|
my $test = Test::Builder->new;
|
|
|
|
# Test::Builder dups stdout/stderr while loading.
|
|
# we need to reset them here to point to $ipc
|
|
$test->output(\*STDOUT);
|
|
$test->failure_output(\*STDERR);
|
|
$test->todo_output(\*STDOUT);
|
|
|
|
@ENV{qw(HOME DISPLAY TESTNAME OUTDIR VALGRIND STRACE XTRACE COVERAGE RESTART)}
|
|
= ($outdir,
|
|
$self->{display},
|
|
basename($file),
|
|
$outdir,
|
|
$options->{valgrind},
|
|
$options->{strace},
|
|
$options->{xtrace},
|
|
$options->{coverage},
|
|
$options->{restart});
|
|
|
|
package main;
|
|
local $@;
|
|
do "./$file";
|
|
$test->ok(undef, "$@") if $@;
|
|
|
|
# XXX hack, we need to trigger the read watcher once more
|
|
# to signal eof to TAP::Parser
|
|
print $EOF;
|
|
|
|
exit 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub worker_next {
|
|
my ($self, $file) = @_;
|
|
|
|
my $ipc = $self->{ipc};
|
|
syswrite $ipc, "$file\n" or die "syswrite: $!";
|
|
}
|
|
|
|
__PACKAGE__ __END__
|