t/op/sigsystem.t

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