t/op/sigsystem.t

   1 #!perl -w
   2
   3 BEGIN {
   4       chdir 't' if -d 't';
   5       require './test.pl';
   6       skip_all_if_miniperl();
   7       skip_all_without_config(qw(d_fork));
   8 }
   9
  10 use strict;
  11 use constant TRUE => ($^X, '-e', 'exit 0');
  12 use Data::Dumper;
  13
  14 plan tests => 4;
  15
  16 SKIP: {
  17     skip 'Platform doesn\'t support SIGCHLD', 4 if not exists $SIG{CHLD};
  18     require POSIX;
  19     require Time::HiRes;
  20
  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     };
  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
  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
  46 sub 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