ext/POSIX/t/waitpid.t

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