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