File: TestWorker.pm

package info (click to toggle)
i3-wm 4.25-2
  • links: PTS, VCS
  • area: main
  • in suites:
  • size: 7,716 kB
  • sloc: ansic: 30,154; perl: 19,229; sh: 70; makefile: 9
file content (149 lines) | stat: -rw-r--r-- 3,618 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
# 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;

        # Preload the i3test module: reduces user CPU from 25s to 18s
        require i3test;

        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 nonexistent testfile $file: $!\n"
            unless -e $file;

        # start a new and self contained process:
        # whatever happens in the testfile should *NOT* affect us.

        my $pid = fork // die "could not fork: $!";
        if ($pid == 0) {
            undef @complete_run::CLEANUP;
            local $SIG{CHLD};

            $0 = $file;

            # Re-seed rand() so that File::Temp’s tempnam produces different
            # results, making a TOCTOU between e.g. t/175-startup-notification.t
            # and t/180-fd-leaks.t less likely.
            srand(time ^ $$);

            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__