From: Gurusamy Sarathy <gsar@cpan.org>
Date: Wed, 16 Aug 2000 23:59:28 +0000 (+0000)
Subject: on windows, the return values from wait() and waitpid() don't
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=68a29c53b68ed5d3196e36d984ad46cc171fe95a;p=p5sagit%2Fp5-mst-13.2.git

on windows, the return values from wait() and waitpid() don't
match those of pseudo-pids

p4raw-id: //depot/perl@6659
---

diff --git a/pp_sys.c b/pp_sys.c
index 4f3abe5..ba9e3bf 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3738,7 +3738,12 @@ PP(pp_wait)
     int argflags;
 
     childpid = wait4pid(-1, &argflags, 0);
+#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
+    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+#  else
     STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+#  endif
     XPUSHi(childpid);
     RETURN;
 #else
@@ -3757,7 +3762,12 @@ PP(pp_waitpid)
     optype = POPi;
     childpid = TOPi;
     childpid = wait4pid(childpid, &argflags, optype);
+#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
+    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+#  else
     STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+#  endif
     SETi(childpid);
     RETURN;
 #else
diff --git a/t/op/fork.t b/t/op/fork.t
index 80c0b72..beb64f9 100755
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -374,3 +374,27 @@ else {
 EXPECT
 pipe_from_fork
 pipe_to_fork
+########
+if ($pid = fork()) {
+    print "forked first kid\n";
+    print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
+}
+else {
+    print "first child\n";
+    exit(0);
+}
+if ($pid = fork()) {
+    print "forked second kid\n";
+    print "wait() returned ok\n" if wait() == $pid;
+}
+else {
+    print "second child\n";
+    exit(0);
+}
+EXPECT
+forked first kid
+first child
+waitpid() returned ok
+forked second kid
+second child
+wait() returned ok
diff --git a/util.c b/util.c
index 28a0025..c0510f3 100644
--- a/util.c
+++ b/util.c
@@ -2676,6 +2676,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 
     if (!pid)
 	return -1;
+#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
     if (pid > 0) {
 	sprintf(spid, "%"IVdf, (IV)pid);
 	svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
@@ -2698,6 +2699,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 	    return pid;
 	}
     }
+#endif
 #ifdef HAS_WAITPID
 #  ifdef HAS_WAITPID_RUNTIME
     if (!HAS_WAITPID_RUNTIME)
diff --git a/win32/win32.c b/win32/win32.c
index 6856884..56ebdaf 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1654,7 +1654,7 @@ win32_waitpid(int pid, int *status, int flags)
 		    *status = (int)((waitcode & 0xff) << 8);
 		    retval = (int)w32_pseudo_child_pids[child];
 		    remove_dead_pseudo_process(child);
-		    return retval;
+		    return -retval;
 		}
 	    }
 	    else
@@ -1720,7 +1720,7 @@ win32_wait(int *status)
 		*status = (int)((exitcode & 0xff) << 8);
 		retval = (int)w32_pseudo_child_pids[i];
 		remove_dead_pseudo_process(i);
-		return retval;
+		return -retval;
 	    }
 	}
     }