Change 13577 by jhi@alpha on 2001/12/10 00:38:09
Add a test case for waitpid(): from Rocco Caputo.
Affected files ...
.... //depot/perl/MANIFEST#659 edit
.... //depot/perl/ext/POSIX/t/waitpid.t#1 add
Differences ...
==== //depot/perl/MANIFEST#659 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Sun Dec 9 17:45:05 2001
+++ perl/MANIFEST Sun Dec 9 17:45:05 2001
@@ -489,6 +489,7 @@
ext/POSIX/POSIX.xs POSIX extension external subroutines
ext/POSIX/t/posix.t See if POSIX works
ext/POSIX/t/sigaction.t See if POSIX::sigaction works
+ext/POSIX/t/waitpid.t See if waitpid works
ext/POSIX/typemap POSIX extension interface types
ext/re/hints/mpeix.pl Hints for re for named architecture
ext/re/Makefile.PL re extension makefile writer
==== //depot/perl/ext/POSIX/t/waitpid.t#1 (text) ====
Index: perl/ext/POSIX/t/waitpid.t
--- perl/ext/POSIX/t/waitpid.t.~1~ Sun Dec 9 17:45:05 2001
+++ perl/ext/POSIX/t/waitpid.t Sun Dec 9 17:45:05 2001
@@ -0,0 +1,88 @@
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
+BEGIN {
+ use Config;
+ unless ($Config{d_fork}) {
+ print "1..0 # no fork\n";
+ exit 0;
+ }
+ eval { use POSIX qw(sys_wait_h) };
+ if ($@) {
+ print "1..0 # no POSIX sys_wait_h\n";
+ exit 0;
+ }
+ eval { use Time::HiRes };
+ if ($@) {
+ print "1..0 # no Time::HiRes\n";
+ exit 0;
+ }
+}
+
+use warnings;
+use strict;
+
+use Time::HiRes qw(time);
+
+$| = 1;
+
+sub NEG1_PROHIBITED () { 0x01 }
+sub NEG1_REQUIRED () { 0x02 }
+
+my $count = 0;
+my $max_count = 9;
+my $state = NEG1_PROHIBITED;
+
+my $child_pid = fork();
+
+# Parent receives a nonzero child PID.
+
+if ($child_pid) {
+ my $ok = 1;
+
+ while ($count++ < $max_count) {
+ my $begin_time = time();
+ my $ret = waitpid( -1, WNOHANG );
+ my $elapsed_time = time() - $begin_time;
+
+ printf( "# waitpid(-1,WNOHANG) returned %d after %.2f seconds\n",
+ $ret, $elapsed_time );
+ if ($elapsed_time > 0.5) {
+ printf( "# %.2f seconds in non-blocking waitpid is too long!\n",
+ $elapsed_time );
+ $ok = 0;
+ last;
+ }
+
+ if ($state & NEG1_PROHIBITED) {
+ if ($ret == -1) {
+ print "# waitpid should not have returned -1 here!\n";
+ $ok = 0;
+ last;
+ }
+ elsif ($ret == $child_pid) {
+ $state = NEG1_REQUIRED;
+ }
+ }
+ elsif ($state & NEG1_REQUIRED) {
+ unless ($ret == -1) {
+ print "# waitpid should have returned -1 here\n";
+ $ok = 0;
+ }
+ last;
+ }
+
+ sleep(1);
+ }
+ print $ok ? "ok 1\n" : "not ok 1\n";
+ exit(0); # parent
+} else {
+ # Child receives a zero PID and can request parent's PID with
+ # getppid().
+ sleep(3);
+ exit(0);
+}
+
+
End of Patch.
