This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ec7f0495600f9c20ad3bac831ba258cbaa0be06c
[perl5.git] / t / op / sigsystem.t
1 #!perl -w
2
3 BEGIN {
4       require './test.pl';
5       skip_all_if_miniperl();
6 }
7
8 use strict;
9 use constant TRUE => ($^X, '-e', 'exit 0');
10 use Data::Dumper;
11
12 plan tests => 4;
13
14 SKIP: {
15     skip 'Platform doesn\'t support SIGCHLD', 4 if not exists $SIG{CHLD};
16     require POSIX;
17     require Time::HiRes;
18
19     my $pid = fork // die "Can't fork: $!";
20     unless ($pid) {
21         note("Child PID: $$");
22         Time::HiRes::sleep(0.250);
23         POSIX::_exit(0);
24     }
25
26     test_system('without reaper');
27
28     my @pids;
29     $SIG{CHLD} = sub {
30         while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
31             note "Reaped: $child";
32             push @pids, $child;
33         }
34     };
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
45 sub 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