X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=7c0af0f11d71e929e22a14d0473ff9537b0de523;hb=f3c90b3644a4d1b01ee1a6fe678bc1357e85a56a;hp=0f67ba12fb9b597841bc3ba4af5ccd821e19baf4;hpb=cba61fe146f58b7c23f03d55e645ba7b4552bb7e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/win32/win32.c b/win32/win32.c
index 0f67ba1..7c0af0f 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1784,8 +1784,19 @@ win32_async_check(pTHX)
 
     w32_poll_count = 0;
 
-    if (hwnd == INVALID_HANDLE_VALUE)
+    if (hwnd == INVALID_HANDLE_VALUE) {
+        /* Call PeekMessage() to mark all pending messages in the queue as "old".
+         * This is necessary when we are being called by win32_msgwait() to
+         * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
+         * message over and over.  An example how this can happen is when
+         * Perl is calling win32_waitpid() inside a GUI application and the GUI
+         * is generating messages before the process terminated.
+         */
+        PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
+        if (PL_sig_pending)
+            despatch_signals();
         return 1;
+    }
 
     /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
      * and ignores window messages - should co-exist better with windows apps e.g. Tk
@@ -2809,6 +2820,7 @@ win32_pclose(PerlIO *pf)
 	childpid = 0;
 
     if (!childpid) {
+        UNLOCK_FDPID_MUTEX;
 	errno = EBADF;
         return -1;
     }
@@ -4862,6 +4874,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 void
 Perl_win32_term(void)
 {
+    HINTS_REFCNT_TERM;
     OP_REFCNT_TERM;
     MALLOC_TERM;
 }