| Line | |
|---|
| 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 # Skip: no fork\n";
|
|---|
| 10 | exit 0;
|
|---|
| 11 | }
|
|---|
| 12 | eval 'use POSIX qw(sys_wait_h)';
|
|---|
| 13 | if ($@) {
|
|---|
| 14 | print "1..0 # Skip: no POSIX sys_wait_h\n";
|
|---|
| 15 | exit 0;
|
|---|
| 16 | }
|
|---|
| 17 | eval 'use Time::HiRes qw(time)';
|
|---|
| 18 | if ($@) {
|
|---|
| 19 | print "1..0 # Skip: no Time::HiRes\n";
|
|---|
| 20 | exit 0;
|
|---|
| 21 | }
|
|---|
| 22 | }
|
|---|
| 23 |
|
|---|
| 24 | use warnings;
|
|---|
| 25 | use strict;
|
|---|
| 26 |
|
|---|
| 27 | $| = 1;
|
|---|
| 28 |
|
|---|
| 29 | print "1..1\n";
|
|---|
| 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 |
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.