summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLeon Timmermans <fawaka@gmail.com>2011-12-30 20:02:07 +0200
committerFather Chrysostomos <sprout@cpan.org>2011-12-31 11:37:04 -0800
commitc56bc16121e4ad4a18754d74c8da1075f9ee65f8 (patch)
tree5c6b3e503e736e9a79165127651f7287d696f64b
parentdb4c290518adacb08e858bff2ae8f18646562f67 (diff)
downloadperl-c56bc16121e4ad4a18754d74c8da1075f9ee65f8.tar.gz
Added tests for SIGCHLD blocking during system()
-rw-r--r--MANIFEST1
-rw-r--r--t/op/sigsystem.t63
2 files changed, 64 insertions, 0 deletions
diff --git a/MANIFEST b/MANIFEST
index 99eb9ef0d8..2df1462169 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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"
+ );
+}
+