various win32 odds and ends

 - added support for waitpid(), open2/open3, and a bugfix for kill()
   from Ronald Schmidt <RonaldWS@aol.com>
 - tweak testsuite mods of above
 - regenerate win32/config_H.?c
 - change kill() to win32_kill() and export it
 - coalesce common code in win32.c
 - add PerlProc_waitpid() and export win32_waitpid()
result builds and passes on the three win32 compilers

p4raw-id: //depot/perl@1134

16 files changed, 121 insertions, 65 deletions

diff --git a/ipproc.h b/ipproc.h
index 80e5da41dd..0395b5bcd2 100644
--- a/ipproc.h
+++ b/ipproc.h
@@ -40,6 +40,7 @@ public:
     virtual int Sleep(unsigned int) = 0;
     virtual int Times(struct tms *timebuf) = 0;
     virtual int Wait(int *status) = 0;
+    virtual int Waitpid(int pid, int *status, int flags) = 0;
     virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0;
 #ifdef WIN32
     virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0;
diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm
index 7b06a21fa4..f1415e3ad6 100644
--- a/lib/IPC/Open3.pm
+++ b/lib/IPC/Open3.pm
@@ -10,7 +10,7 @@ require Exporter;
 use Carp;
 use Symbol 'qualify';
 
-$VERSION	= 1.0101;
+$VERSION	= 1.0102;
 @ISA		= qw(Exporter);
 @EXPORT		= qw(open3);
 
@@ -66,6 +66,7 @@ C<cat -v> and continually read and write a line from it.
 # &open3: Marc Horowitz <marc@mit.edu>
 # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
 # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
+# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
 #
 # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
 #
@@ -119,7 +120,7 @@ sub xclose {
     close $_[0] or croak "$Me: close($_[0]) failed: $!";
 }
 
-my $do_spawn = $^O eq 'os2';
+my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
 
 sub _open3 {
     local $Me = shift;
@@ -267,10 +268,12 @@ sub spawn_with_handles {
 	$fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
 			      $fd->{mode});
     }
-    # Stderr may be redirected below, so we save the err text:
-    foreach $fd (@$close_in_child) {
-	fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
-	    unless $saved{fileno $fd};	# Do not close what we redirect!
+    unless ($^O eq 'MSWin32') {
+	# Stderr may be redirected below, so we save the err text:
+	foreach $fd (@$close_in_child) {
+	    fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
+		unless $saved{fileno $fd}; # Do not close what we redirect!
+	}
     }
 
     unless (@errs) {
diff --git a/perlproc.h b/perlproc.h
index 8e58c2232d..adf66a2940 100644
--- a/perlproc.h
+++ b/perlproc.h
@@ -27,6 +27,7 @@
 #define PerlProc_sleep(t) piProc->Sleep((t))
 #define PerlProc_times(t) piProc->Times((t))
 #define PerlProc_wait(t) piProc->Wait((t))
+#define PerlProc_waitpid(p, s, f) piProc->Waitpid((p), (s), (f))
 #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
 #define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
 #define PerlProc_signal(n, h) piProc->Signal((n), (h))
@@ -61,6 +62,7 @@
 #define PerlProc_sleep(t) sleep((t))
 #define PerlProc_times(t) times((t))
 #define PerlProc_wait(t) wait((t))
+#define PerlProc_waitpid(p, s, f) waitpid((p), (s), (f))
 #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
 #define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
 #define PerlProc_signal(n, h) signal((n), (h))
diff --git a/t/lib/open2.t b/t/lib/open2.t
index a2e6a07a7b..85b807c98a 100755
--- a/t/lib/open2.t
+++ b/t/lib/open2.t
@@ -4,7 +4,10 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
-    unless ($Config{'d_fork'}) {
+    if (!$Config{'d_fork'}
+       # open2/3 supported on win32 (but not Borland due to CRT bugs)
+       && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i))
+    {
 	print "1..0\n";
 	exit 0;
     }
@@ -25,20 +28,30 @@ sub ok {
 	print "ok $n\n";
     }
     else {
-    	print "not ok $n\n";
+	print "not ok $n\n";
 	print "# $info\n" if $info;
     }
 }
 
+sub cmd_line {
+	if ($^O eq 'MSWin32') {
+		return qq/"$_[0]"/;
+	}
+	else {
+		return $_[0];
+	}
+}
+
 my ($pid, $reaped_pid);
 STDOUT->autoflush;
 STDERR->autoflush;
 
 print "1..7\n";
 
-ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e', 'print scalar <STDIN>';
+ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
+	cmd_line('print scalar <STDIN>');
 ok 2, print WRITE "hi kid\n";
-ok 3, <READ> eq "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
 ok 4, close(WRITE), $!;
 ok 5, close(READ), $!;
 $reaped_pid = waitpid $pid, 0;
diff --git a/t/lib/open3.t b/t/lib/open3.t
index 4258eec401..b84dac9f14 100755
--- a/t/lib/open3.t
+++ b/t/lib/open3.t
@@ -4,7 +4,10 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
-    unless ($Config{'d_fork'}) {
+    if (!$Config{'d_fork'}
+       # open2/3 supported on win32 (but not Borland due to CRT bugs)
+       && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i))
+    {
 	print "1..0\n";
 	exit 0;
     }
@@ -25,11 +28,23 @@ sub ok {
 	print "ok $n\n";
     }
     else {
-    	print "not ok $n\n";
+	print "not ok $n\n";
 	print "# $info\n" if $info;
     }
 }
 
+sub cmd_line {
+	if ($^O eq 'MSWin32') {
+		my $cmd = shift;
+		$cmd =~ tr/\r\n//d;
+		$cmd =~ s/"/\\"/g;
+		return qq/"$cmd"/;
+	}
+	else {
+		return $_[0];
+	}
+}
+
 my ($pid, $reaped_pid);
 STDOUT->autoflush;
 STDERR->autoflush;
@@ -37,14 +52,14 @@ STDERR->autoflush;
 print "1..21\n";
 
 # basic
-ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', <<'EOF';
+ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
     $| = 1;
     print scalar <STDIN>;
     print STDERR "hi error\n";
 EOF
 ok 2, print WRITE "hi kid\n";
-ok 3, <READ> eq "hi kid\n";
-ok 4, <ERROR> eq "hi error\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, <ERROR> =~ /^hi error\r?\n$/;
 ok 5, close(WRITE), $!;
 ok 6, close(READ), $!;
 ok 7, close(ERROR), $!;
@@ -53,7 +68,7 @@ ok 8, $reaped_pid == $pid, $reaped_pid;
 ok 9, $? == 0, $?;
 
 # read and error together, both named
-$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
     $| = 1;
     print scalar <STDIN>;
     print STDERR scalar <STDIN>;
@@ -65,7 +80,7 @@ print scalar <READ>;
 waitpid $pid, 0;
 
 # read and error together, error empty
-$pid = open3 'WRITE', 'READ', '', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
     $| = 1;
     print scalar <STDIN>;
     print STDERR scalar <STDIN>;
@@ -79,7 +94,7 @@ waitpid $pid, 0;
 # dup writer
 ok 14, pipe PIPE_READ, PIPE_WRITE;
 $pid = open3 '<&PIPE_READ', 'READ', '',
-		    $perl, '-e', 'print scalar <STDIN>';
+		    $perl, '-e', cmd_line('print scalar <STDIN>');
 close PIPE_READ;
 print PIPE_WRITE "ok 15\n";
 close PIPE_WRITE;
@@ -88,7 +103,7 @@ waitpid $pid, 0;
 
 # dup reader
 $pid = open3 'WRITE', '>&STDOUT', 'ERROR',
-		    $perl, '-e', 'print scalar <STDIN>';
+		    $perl, '-e', cmd_line('print scalar <STDIN>');
 print WRITE "ok 16\n";
 waitpid $pid, 0;
 
@@ -96,12 +111,12 @@ waitpid $pid, 0;
 # stdout but putting stdout somewhere else, is a good case because it
 # used not to work.
 $pid = open3 'WRITE', 'READ', '>&STDOUT',
-		    $perl, '-e', 'print STDERR scalar <STDIN>';
+		    $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
 print WRITE "ok 17\n";
 waitpid $pid, 0;
 
 # dup reader and error together, both named
-$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
     $| = 1;
     print STDOUT scalar <STDIN>;
     print STDERR scalar <STDIN>;
@@ -111,7 +126,7 @@ print WRITE "ok 19\n";
 waitpid $pid, 0;
 
 # dup reader and error together, error empty
-$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
     $| = 1;
     print STDOUT scalar <STDIN>;
     print STDERR scalar <STDIN>;
diff --git a/util.c b/util.c
index 294a68e3b9..2fa77408a9 100644
--- a/util.c
+++ b/util.c
@@ -2134,7 +2134,7 @@ wait4pid(int pid, int *statusp, int flags)
     if (!HAS_WAITPID_RUNTIME)
 	goto hard_way;
 #  endif
-    return waitpid(pid,statusp,flags);
+    return PerlProc_waitpid(pid,statusp,flags);
 #endif
 #if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
@@ -2859,4 +2859,4 @@ SV **
 get_specialsv_list(void)
 {
  return specialsv_list;
-}
\ No newline at end of file
+}
diff --git a/win32/config.bc b/win32/config.bc
index 453c6fdc25..2d25e46ef3 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -271,7 +271,7 @@ d_voidtty=''
 d_volatile='define'
 d_vprintf='define'
 d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
 d_wcstombs='define'
 d_wctomb='define'
 d_xenix='undef'
diff --git a/win32/config.gc b/win32/config.gc
index ac5fa5f7ca..b98a55ec2e 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -271,7 +271,7 @@ d_voidtty=''
 d_volatile='define'
 d_vprintf='define'
 d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
 d_wcstombs='define'
 d_wctomb='define'
 d_xenix='undef'
diff --git a/win32/config.vc b/win32/config.vc
index 8699e29e5d..806549c363 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -271,7 +271,7 @@ d_voidtty=''
 d_volatile='define'
 d_vprintf='define'
 d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
 d_wcstombs='define'
 d_wctomb='define'
 d_xenix='undef'
diff --git a/win32/config_H.bc b/win32/config_H.bc
index ce21ebff2f..ca5ab3a476 100644
--- a/win32/config_H.bc
+++ b/win32/config_H.bc
@@ -788,7 +788,7 @@
  *	This symbol, if defined, indicates that the waitpid routine is
  *	available to wait for child process.
  */
-/*#define HAS_WAITPID	/**/
+#define HAS_WAITPID	/**/
 
 /* HAS_WCSTOMBS:
  *	This symbol, if defined, indicates that the wcstombs routine is
@@ -1616,12 +1616,6 @@
 #define LONGLONGSIZE 8		/**/
 #endif
 
-/* HAS_MKSTEMP:
- *	This symbol, if defined, indicates that the mkstemp routine is
- *	available to create and open a unique temporary file.
- */
-/*#define HAS_MKSTEMP		/**/
-
 /* HAS_SETGROUPS:
  *	This symbol, if defined, indicates that the setgroups() routine is
  *	available to set the list of process groups.  If unavailable, multiple
diff --git a/win32/config_H.gc b/win32/config_H.gc
index 22f12586e7..7ec7c7f16b 100644
--- a/win32/config_H.gc
+++ b/win32/config_H.gc
@@ -788,7 +788,7 @@
  *	This symbol, if defined, indicates that the waitpid routine is
  *	available to wait for child process.
  */
-/*#define HAS_WAITPID	/**/
+#define HAS_WAITPID	/**/
 
 /* HAS_WCSTOMBS:
  *	This symbol, if defined, indicates that the wcstombs routine is
@@ -1616,12 +1616,6 @@
 #define LONGLONGSIZE 8		/**/
 #endif
 
-/* HAS_MKSTEMP:
- *	This symbol, if defined, indicates that the mkstemp routine is
- *	available to create and open a unique temporary file.
- */
-/*#define HAS_MKSTEMP		/**/
-
 /* HAS_SETGROUPS:
  *	This symbol, if defined, indicates that the setgroups() routine is
  *	available to set the list of process groups.  If unavailable, multiple
diff --git a/win32/config_H.vc b/win32/config_H.vc
index 0ff8941b83..40870c5c90 100644
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -788,7 +788,7 @@
  *	This symbol, if defined, indicates that the waitpid routine is
  *	available to wait for child process.
  */
-/*#define HAS_WAITPID	/**/
+#define HAS_WAITPID	/**/
 
 /* HAS_WCSTOMBS:
  *	This symbol, if defined, indicates that the wcstombs routine is
@@ -1616,12 +1616,6 @@
 #define LONGLONGSIZE 8		/**/
 #endif
 
-/* HAS_MKSTEMP:
- *	This symbol, if defined, indicates that the mkstemp routine is
- *	available to create and open a unique temporary file.
- */
-/*#define HAS_MKSTEMP		/**/
-
 /* HAS_SETGROUPS:
  *	This symbol, if defined, indicates that the setgroups() routine is
  *	available to set the list of process groups.  If unavailable, multiple
diff --git a/win32/makedef.pl b/win32/makedef.pl
index 65e8023962..059fc4927d 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -575,6 +575,8 @@ win32_get_osfhandle
 win32_ioctl
 win32_utime
 win32_wait
+win32_waitpid
+win32_kill
 win32_str_os_error
 Perl_win32_init
 Perl_init_os_extras
diff --git a/win32/runperl.c b/win32/runperl.c
index 17d2ac2a57..7d49182168 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -582,7 +582,7 @@ public:
     };
     virtual int Kill(int pid, int sig)
     {
-	return kill(pid, sig);
+	return win32_kill(pid, sig);
     };
     virtual int Killpg(int pid, int sig)
     {
@@ -627,6 +627,10 @@ public:
     {
 	return win32_wait(status);
     };
+    virtual int Waitpid(int pid, int *status, int flags)
+    {
+	return win32_waitpid(pid, status, flags);
+    };
     virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
     {
 	return 0;
diff --git a/win32/win32.c b/win32/win32.c
index 3a0583c0fe..9afb0bd687 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -111,6 +111,7 @@ static BOOL		has_redirection(char *ptr);
 static long		filetime_to_clock(PFILETIME ft);
 static BOOL		filetime_from_time(PFILETIME ft, time_t t);
 static char *		get_emd_part(char *leading, char *trailing, ...);
+static void		remove_dead_process(HANDLE deceased);
 
 HANDLE	w32_perldll_handle = INVALID_HANDLE_VALUE;
 static DWORD	w32_platform = (DWORD)-1;
@@ -840,10 +841,30 @@ chown(const char *path, uid_t owner, gid_t group)
     return 0;
 }
 
-int
-kill(int pid, int sig)
+static void
+remove_dead_process(HANDLE deceased)
 {
+#ifndef USE_RTL_WAIT
+    int child;
+    for (child = 0 ; child < w32_num_children ; ++child) {
+	if (w32_child_pids[child] == deceased) {
+	    Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+		 (w32_num_children-child-1), HANDLE);
+	    w32_num_children--;
+	    break;
+	}
+    }
+#endif
+}
+
+DllExport int
+win32_kill(int pid, int sig)
+{
+#ifdef USE_RTL_WAIT
     HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+#else
+    HANDLE hProcess = (HANDLE) pid;
+#endif
 
     if (hProcess == NULL) {
 	croak("kill process failed!\n");
@@ -852,6 +873,10 @@ kill(int pid, int sig)
 	if (!TerminateProcess(hProcess, sig))
 	    croak("kill process failed!\n");
 	CloseHandle(hProcess);
+
+	/* WaitForMultipleObjects() on a pid that was killed returns error
+	 * so if we know the pid is gone we remove it from process list */
+	remove_dead_process(hProcess);
     }
     return 0;
 }
@@ -1050,6 +1075,24 @@ win32_utime(const char *filename, struct utimbuf *times)
 }
 
 DllExport int
+win32_waitpid(int pid, int *status, int flags)
+{
+    int rc;
+    if (pid == -1) 
+      return win32_wait(status);
+    else {
+      rc = cwait(status, pid, WAIT_CHILD);
+    /* cwait() returns differently on Borland */
+#ifdef __BORLANDC__
+    if (status)
+	*status =  (((*status >> 8) & 0xff) | ((*status << 8) & 0xff00));
+#endif
+      remove_dead_process((HANDLE)pid);
+    }
+    return rc >= 0 ? pid : rc;                
+}
+
+DllExport int
 win32_wait(int *status)
 {
 #ifdef USE_RTL_WAIT
@@ -1666,10 +1709,6 @@ win32_pclose(FILE *pf)
     return _pclose(pf);
 #else
 
-#ifndef USE_RTL_WAIT
-    int child;
-#endif
-
     int childpid, status;
     SV *sv;
 
@@ -1687,16 +1726,7 @@ win32_pclose(FILE *pf)
     win32_fclose(pf);
     SvIVX(sv) = 0;
 
-#ifndef USE_RTL_WAIT
-    for (child = 0 ; child < w32_num_children ; ++child) {
-	if (w32_child_pids[child] == (HANDLE)childpid) {
-	    Copy(&w32_child_pids[child+1], &w32_child_pids[child],
-		 (w32_num_children-child-1), HANDLE);
-	    w32_num_children--;
-	    break;
-	}
-    }
-#endif
+    remove_dead_process((HANDLE)childpid);
 
     /* wait for the child */
     if (cwait(&status, childpid, WAIT_CHILD) == -1)
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 339b7c5fb1..6f4444eb3b 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -123,6 +123,8 @@ DllExport  int		win32_stat(const char *path, struct stat *buf);
 DllExport  int		win32_ioctl(int i, unsigned int u, char *data);
 DllExport  int		win32_utime(const char *f, struct utimbuf *t);
 DllExport  int		win32_wait(int *status);
+DllExport  int		win32_waitpid(int pid, int *status, int flags);
+DllExport  int		win32_kill(int pid, int sig);
 
 #ifdef HAVE_DES_FCRYPT
 DllExport char *	win32_crypt(const char *txt, const char *salt);
@@ -257,6 +259,8 @@ END_EXTERN_C
 #define ioctl			win32_ioctl
 #define utime			win32_utime
 #define wait			win32_wait
+#define waitpid			win32_waitpid
+#define kill			win32_kill
 
 #ifdef HAVE_DES_FCRYPT
 #undef crypt