diff options
author | Leon Timmermans <fawaka@gmail.com> | 2011-12-30 20:02:07 +0200 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-12-31 11:37:04 -0800 |
commit | c56bc16121e4ad4a18754d74c8da1075f9ee65f8 (patch) | |
tree | 5c6b3e503e736e9a79165127651f7287d696f64b | |
parent | db4c290518adacb08e858bff2ae8f18646562f67 (diff) | |
download | perl-c56bc16121e4ad4a18754d74c8da1075f9ee65f8.tar.gz |
Added tests for SIGCHLD blocking during system()
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | t/op/sigsystem.t | 63 |
2 files changed, 64 insertions, 0 deletions
@@ -5273,6 +5273,7 @@ t/op/runlevel.t See if die() works from perl_call_*() t/op/select.t See if 0- and 1-argument select works t/op/setpgrpstack.t See if setpgrp works t/op/sigdispatch.t See if signals are always dispatched +t/op/sigsystem.t See if system and SIGCHLD handlers play together nicely t/op/sleep.t See if sleep works t/op/smartkve.t See if smart deref for keys/values/each works t/op/smartmatch.t See if the ~~ operator works diff --git a/t/op/sigsystem.t b/t/op/sigsystem.t new file mode 100644 index 0000000000..0197ad9e61 --- /dev/null +++ b/t/op/sigsystem.t @@ -0,0 +1,63 @@ +#!perl -w + +BEGIN { + require './test.pl'; +} + +use strict; +use constant TRUE => ($^X, '-e', 'exit 0'); +use Data::Dumper; + +plan tests => 4; + +SKIP: { + skip 'Platform doesn\'t support SIGCHLD', 3 if is_miniperl() or not exists $SIG{CHLD}; + require POSIX; + require Time::HiRes; + + my $pid = fork // die "Can't fork: $!"; + unless ($pid) { + note("Child PID: $$"); + Time::HiRes::sleep(0.250); + POSIX::_exit(0); + } + + test_system('without reaper'); + + my @pids; + $SIG{CHLD} = sub { + while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) { + note "Reaped: $child"; + push @pids, $child; + } + }; + + 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" + ); +} + |