ext/POSIX/t/waitpid.t

   1 BEGIN {
   2     use Config;
   3     unless ($Config{d_fork}) {
   4         print "1..0 # Skip: no fork\n";
   5         exit 0;
   6     }
   7     eval 'use POSIX qw(sys_wait_h)';
   8     if ($@) {
   9         print "1..0 # Skip: no POSIX sys_wait_h\n";
  10         exit 0;
  11     }
  12     eval 'use Time::HiRes qw(time)';
  13     if ($@) {
  14         print "1..0 # Skip: no Time::HiRes\n";
  15         exit 0;
  16     }
  17 }
  18
  19 use warnings;
  20 use strict;
  21
  22 $| = 1;
  23
  24 print "1..1\n";
  25
  26 sub NEG1_PROHIBITED () { 0x01 }
  27 sub NEG1_REQUIRED   () { 0x02 }
  28
  29 my $count     = 0;
  30 my $max_count = 9;
  31 my $state     = NEG1_PROHIBITED;
  32
  33 my $child_pid = fork();
  34
  35 # Parent receives a nonzero child PID.
  36
  37 if ($child_pid) {
  38     my $ok = 1;
  39
  40     while ($count++ < $max_count) {
  41         my $begin_time = time();
  42         my $ret = waitpid( -1, WNOHANG );
  43         my $elapsed_time = time() - $begin_time;
  44
  45         printf( "# waitpid(-1,WNOHANG) returned %d after %.2f seconds\n",
  46                 $ret, $elapsed_time );
  47         if ($elapsed_time > 0.5) {
  48             printf( "# %.2f seconds in non-blocking waitpid is too long!\n",
  49                     $elapsed_time );
  50             $ok = 0;
  51             last;
  52         }
  53
  54         if ($state & NEG1_PROHIBITED) {
  55             if ($ret == -1) {
  56                 print "# waitpid should not have returned -1 here!\n";
  57                 $ok = 0;
  58                 last;
  59             }
  60             elsif ($ret == $child_pid) {
  61                 $state = NEG1_REQUIRED;
  62             }
  63         }
  64         elsif ($state & NEG1_REQUIRED) {
  65             unless ($ret == -1) {
  66                 print "# waitpid should have returned -1 here\n";
  67                 $ok = 0;
  68             }
  69             last;
  70         }
  71
  72         sleep(1);
  73     }
  74     print $ok ? "ok 1\n" : "not ok 1\n";
  75     exit(0); # parent
  76 } else {
  77     # Child receives a zero PID and can request parent's PID with
  78     # getppid().
  79     sleep(3);
  80     exit(0);
  81 }
  82
  83