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