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 $pid = fork // die "Can't fork: $!"; 21 unless ($pid) { 22 note("Child PID: $$"); 23 Time::HiRes::sleep(0.250); 24 POSIX::_exit(0); 25 } 26 27 test_system('without reaper'); 28 29 my @pids; 30 $SIG{CHLD} = sub { 31 while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) { 32 note "Reaped: $child"; 33 push @pids, $child; 34 } 35 }; 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