1#!perl -w
2
3BEGIN {
4      chdir 't' if -d 't';
5      require './test.pl';
6      skip_all_if_miniperl();
7      skip_all_without_config(qw(d_fork));
8}
9
10use strict;
11use constant TRUE => ($^X, '-e', 'exit 0');
12use Data::Dumper;
13
14plan tests => 4;
15
16SKIP: {
17    skip 'Platform doesn\'t support SIGCHLD', 4 if not exists $SIG{CHLD};
18    require POSIX;
19    require Time::HiRes;
20
21    my @pids;
22    $SIG{CHLD} = sub {
23	while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
24	    note "Reaped: $child";
25	    push @pids, $child;
26	}
27    };
28    my $pid = fork // die "Can't fork: $!";
29    unless ($pid) {
30	note("Child PID: $$");
31	Time::HiRes::sleep(0.250);
32	POSIX::_exit(0);
33    }
34
35    test_system('without reaper');
36
37    test_system('with reaper');
38
39    note("Waiting briefly for SIGCHLD...");
40    Time::HiRes::sleep(0.500);
41
42    ok(@pids == 1, 'Reaped only one process');
43    ok($pids[0] == $pid, "Reaped the right process.") or diag(Dumper(\@pids));
44}
45
46sub test_system {
47    my $subtest = shift;
48
49    my $expected_zeroes = 10;
50    my $got_zeroes      = 0;
51
52    # This test is looking for a race between system()'s waitpid() and a
53    # signal handler.    Looping a few times increases the chances of
54    # catching the error.
55
56    for (1..$expected_zeroes) {
57	$got_zeroes++ unless system(TRUE);
58    }
59
60    is(
61	$got_zeroes, $expected_zeroes,
62	"system() $subtest succeeded $got_zeroes times out of $expected_zeroes"
63    );
64}
65
66