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