change#6328 could make close(SOCKET) return false on windows

[p5sagit/p5-mst-13.2.git] / win32 / win32.c

diff --git a/win32/win32.c b/win32/win32.c
index 008d7e0..6856884 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -53,7 +53,6 @@
 #else
 #include <utime.h>
 #endif
-
 #ifdef __GNUC__
 /* Mingw32 defaults to globing command line 
  * So we turn it off like this:
@@ -1645,8 +1644,12 @@ win32_waitpid(int pid, int *status, int flags)
        long child = find_pseudo_pid(-pid);
        if (child >= 0) {
            HANDLE hThread = w32_pseudo_child_handles[child];
-           DWORD waitcode = WaitForSingleObject(hThread, INFINITE);
-           if (waitcode != WAIT_FAILED) {
+           DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
+           DWORD waitcode = WaitForSingleObject(hThread, timeout);
+           if (waitcode == WAIT_TIMEOUT) {
+               return 0;
+           }
+           else if (waitcode != WAIT_FAILED) {
                if (GetExitCodeThread(hThread, &waitcode)) {
                    *status = (int)((waitcode & 0xff) << 8);
                    retval = (int)w32_pseudo_child_pids[child];
@@ -1663,14 +1666,18 @@ win32_waitpid(int pid, int *status, int flags)
        long child = find_pid(pid);
        if (child >= 0) {
            HANDLE hProcess = w32_child_handles[child];
-           DWORD waitcode = WaitForSingleObject(hProcess, INFINITE);
-           if (waitcode != WAIT_FAILED) {
-               if (GetExitCodeProcess(hProcess, &waitcode)) {
-                   *status = (int)((waitcode & 0xff) << 8);
-                   retval = (int)w32_child_pids[child];
-                   remove_dead_process(child);
-                   return retval;
-               }
+           DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
+           DWORD waitcode = WaitForSingleObject(hProcess, timeout);
+           if (waitcode == WAIT_TIMEOUT) {
+               return 0;
+           }
+           else if (waitcode != WAIT_FAILED) {
+                if (GetExitCodeProcess(hProcess, &waitcode)) {
+                    *status = (int)((waitcode & 0xff) << 8);
+                    retval = (int)w32_child_pids[child];
+                    remove_dead_process(child);
+                    return retval;
+                }
            }
            else
                errno = ECHILD;
@@ -2393,7 +2400,9 @@ win32_popen(const char *command, const char *mode)
        /* close saved handle */
        win32_close(oldfd);
 
+       LOCK_FDPID_MUTEX;
        sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+       UNLOCK_FDPID_MUTEX;
 
        /* set process id so that it can be returned by perl's open() */
        PL_forkprocess = childpid;
@@ -2429,7 +2438,9 @@ win32_pclose(FILE *pf)
     int childpid, status;
     SV *sv;
 
+    LOCK_FDPID_MUTEX;
     sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+
     if (SvIOK(sv))
        childpid = SvIVX(sv);
     else
@@ -2442,6 +2453,7 @@ win32_pclose(FILE *pf)
 
     win32_fclose(pf);
     SvIVX(sv) = 0;
+    UNLOCK_FDPID_MUTEX;
 
     if (win32_waitpid(childpid, &status, 0) == -1)
         return -1;
@@ -3968,18 +3980,6 @@ Perl_init_os_extras(void)
     char *file = __FILE__;
     dXSUB_SYS;
 
-    w32_perlshell_tokens = Nullch;
-    w32_perlshell_items = -1;
-    w32_fdpid = newAV();               /* XXX needs to be in Perl_win32_init()? */
-    New(1313, w32_children, 1, child_tab);
-    w32_num_children = 0;
-    w32_init_socktype = 0;
-#ifdef USE_ITHREADS
-    w32_pseudo_id = 0;
-    New(1313, w32_pseudo_children, 1, child_tab);
-    w32_num_pseudo_children = 0;
-#endif
-
     /* these names are Activeware compatible */
     newXS("Win32::GetCwd", w32_GetCwd, file);
     newXS("Win32::SetCwd", w32_SetCwd, file);
@@ -4037,16 +4037,50 @@ win32_get_child_IO(child_IO_table* ptbl)
     ptbl->childStdErr  = GetStdHandle(STD_ERROR_HANDLE);
 }
 
-
-#ifdef USE_ITHREADS
+#ifdef HAVE_INTERP_INTERN
 
 #  ifdef PERL_OBJECT
+#    undef Perl_sys_intern_init
+#    define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init
 #    undef Perl_sys_intern_dup
 #    define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
+#    undef Perl_sys_intern_clear
+#    define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear
 #    define pPerl this
 #  endif
 
 void
+Perl_sys_intern_init(pTHX)
+{
+    w32_perlshell_tokens       = Nullch;
+    w32_perlshell_vec          = (char**)NULL;
+    w32_perlshell_items                = 0;
+    w32_fdpid                  = newAV();
+    New(1313, w32_children, 1, child_tab);
+    w32_num_children           = 0;
+#  ifdef USE_ITHREADS
+    w32_pseudo_id              = 0;
+    New(1313, w32_pseudo_children, 1, child_tab);
+    w32_num_pseudo_children    = 0;
+#  endif
+    w32_init_socktype          = 0;
+}
+
+void
+Perl_sys_intern_clear(pTHX)
+{
+    Safefree(w32_perlshell_tokens);
+    Safefree(w32_perlshell_vec);
+    /* NOTE: w32_fdpid is freed by sv_clean_all() */
+    Safefree(w32_children);
+#  ifdef USE_ITHREADS
+    Safefree(w32_pseudo_children);
+#  endif
+}
+
+#  ifdef USE_ITHREADS
+
+void
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
 {
     dst->perlshell_tokens      = Nullch;
@@ -4054,12 +4088,12 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     dst->perlshell_items       = 0;
     dst->fdpid                 = newAV();
     Newz(1313, dst->children, 1, child_tab);
-    Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->pseudo_id             = 0;
-    dst->children->num         = 0;
+    Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
 }
-#endif
+#  endif /* USE_ITHREADS */
+#endif /* HAVE_INTERP_INTERN */
 
 #ifdef PERL_OBJECT
 #  undef this