In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/d4c027436fbaf9384f42d7c7703b2499810ed39b?hp=18603efee1e80bda2f6107c9569d056cb1071d4b>
- Log -----------------------------------------------------------------
commit d4c027436fbaf9384f42d7c7703b2499810ed39b
Author: Tony Cook <t...@develop-help.com>
Date: Tue Sep 17 16:57:37 2013 +1000
[perl #85228] stop $!=EINVAL; waitpid(0,0) from looping
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
t/op/waitpid.t | 39 +++++++++++++++++++++++++++++++++++++++
util.c | 13 ++++++++++---
3 files changed, 50 insertions(+), 3 deletions(-)
create mode 100644 t/op/waitpid.t
diff --git a/MANIFEST b/MANIFEST
index 63ac7ce..66cadf1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5363,6 +5363,7 @@ t/op/utfhash.t See if utf8 keys in
hashes behave
t/op/utftaint.t See if utf8 and taint work together
t/op/vec.t See if vectors work
t/op/ver.t See if v-strings and the %v format flag work
+t/op/waitpid.t See if waitpid works
t/op/wantarray.t See if wantarray works
t/op/warn.t See if warn works
t/op/while.t See if while loops work
diff --git a/t/op/waitpid.t b/t/op/waitpid.t
new file mode 100644
index 0000000..aff2b99
--- /dev/null
+++ b/t/op/waitpid.t
@@ -0,0 +1,39 @@
+#!./perl
+
+# tests for (possibly emulated) waitpid
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+ require Config;
+ skip_all('no Errno')
+ unless eval 'use Errno qw(EINVAL); 1';
+ skip_all('no POSIX')
+ unless eval 'use POSIX qw(WNOHANG); 1';
+}
+
+$|=1;
+
+watchdog(10);
+{
+ # [perl #85228] Broken waitpid
+ # $! = EINVAL; waitpid 0, 0; # would loop forever, even with WNOHANG
+ $! = EINVAL;
+ my $pid = waitpid(0, WNOHANG);
+
+ # depending on the platform, there's several possible values for
+ # $pid and $!, so I'm only testing that we don't loop forever.
+ #
+ # Some of the complications are:
+ #
+ # - watchdog() may be implemented with alarm() or fork, so there
+ # may or may not be children (this code doesn't use threads, so
+ # threads shouldn't be used)
+ #
+ # - the platform may or may not implement waitpid()/wait4()
+
+ pass("didn't block on waitpid(0, ...)");
+}
+
+done_testing();
diff --git a/util.c b/util.c
index 79e4000..ef464f7 100644
--- a/util.c
+++ b/util.c
@@ -2796,9 +2796,16 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
dVAR;
I32 result = 0;
PERL_ARGS_ASSERT_WAIT4PID;
- if (!pid)
- return -1;
#ifdef PERL_USES_PL_PIDSTATUS
+ if (!pid) {
+ /* PERL_USES_PL_PIDSTATUS is only defined when neither
+ waitpid() nor wait4() is available, or on OS/2, which
+ doesn't appear to support waiting for a progress group
+ member, so we can only treat a 0 pid as an unknown child.
+ */
+ errno = ECHILD;
+ return -1;
+ }
{
if (pid > 0) {
/* The keys in PL_pidstatus are now the raw 4 (or 8) bytes of the
@@ -2845,7 +2852,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
goto finish;
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
- result = wait4((pid==-1)?0:pid,statusp,flags,NULL);
+ result = wait4(pid,statusp,flags,NULL);
goto finish;
#endif
#ifdef PERL_USES_PL_PIDSTATUS
--
Perl5 Master Repository
