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
|
#!perl -w
BEGIN {
require './test.pl';
skip_all_if_miniperl();
skip_all_without_config(qw(d_fork));
}
use strict;
use constant TRUE => ($^X, '-e', 'exit 0');
use Data::Dumper;
plan tests => 4;
SKIP: {
skip 'Platform doesn\'t support SIGCHLD', 4 if not exists $SIG{CHLD};
require POSIX;
require Time::HiRes;
my @pids;
$SIG{CHLD} = sub {
while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
note "Reaped: $child";
push @pids, $child;
}
};
my $pid = fork // die "Can't fork: $!";
unless ($pid) {
note("Child PID: $$");
Time::HiRes::sleep(0.250);
POSIX::_exit(0);
}
test_system('without reaper');
test_system('with reaper');
note("Waiting briefly for SIGCHLD...");
Time::HiRes::sleep(0.500);
ok(@pids == 1, 'Reaped only one process');
ok($pids[0] == $pid, "Reaped the right process.") or diag(Dumper(\@pids));
}
sub test_system {
my $subtest = shift;
my $expected_zeroes = 10;
my $got_zeroes = 0;
# This test is looking for a race between system()'s waitpid() and a
# signal handler. Looping a few times increases the chances of
# catching the error.
for (1..$expected_zeroes) {
$got_zeroes++ unless system(TRUE);
}
is(
$got_zeroes, $expected_zeroes,
"system() $subtest succeeded $got_zeroes times out of $expected_zeroes"
);
}
|
