This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a test case for waitpid(): from Rocco Caputo.
[perl5.git] / 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