From: Gurusamy Sarathy Date: Mon, 15 Jun 1998 04:07:18 +0000 (+0000) Subject: various win32 odds and ends X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f55ee38a033ce570145fdd38bb9f09acf59d37cd;p=p5sagit%2Fp5-mst-13.2.git various win32 odds and ends - added support for waitpid(), open2/open3, and a bugfix for kill() from Ronald Schmidt - 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 --- diff --git a/ipproc.h b/ipproc.h index 80e5da4..0395b5b 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 7b06a21..f1415e3 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 and continually read and write a line from it. # &open3: Marc Horowitz # derived mostly from &open2 by tom christiansen, # fixed for 5.001 by Ulrich Kunitz +# 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 8e58c22..adf66a2 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 a2e6a07..85b807c 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 '; +ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e', + cmd_line('print scalar '); ok 2, print WRITE "hi kid\n"; -ok 3, eq "hi kid\n"; +ok 3, =~ /^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 4258eec..b84dac9 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 ; print STDERR "hi error\n"; EOF ok 2, print WRITE "hi kid\n"; -ok 3, eq "hi kid\n"; -ok 4, eq "hi error\n"; +ok 3, =~ /^hi kid\r?\n$/; +ok 4, =~ /^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 ; print STDERR scalar ; @@ -65,7 +80,7 @@ print scalar ; 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 ; print STDERR scalar ; @@ -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 '; + $perl, '-e', cmd_line('print scalar '); 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 '; + $perl, '-e', cmd_line('print scalar '); 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 '; + $perl, '-e', cmd_line('print STDERR scalar '); 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 ; print STDERR scalar ; @@ -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 ; print STDERR scalar ; diff --git a/util.c b/util.c index 294a68e..2fa7740 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 453c6fd..2d25e46 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 ac5fa5f..b98a55e 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 8699e29..806549c 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 ce21ebf..ca5ab3a 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 22f1258..7ec7c7f 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 0ff8941..40870c5 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 65e8023..059fc49 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 17d2ac2..7d49182 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 3a0583c..9afb0bd 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 339b7c5..6f4444e 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