[commit: ghc] master: base: Fix fdReady() returning immediately for pipes on Windows. (66240c9)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/66240c9bc77408f841e8cf974d44580434fb1a48/ghc

>---------------------------------------------------------------

commit 66240c9bc77408f841e8cf974d44580434fb1a48
Author: Niklas Hambüchen <mail at nh2.me>
Date:   Tue Sep 19 15:11:05 2017 -0400

    base: Fix fdReady() returning immediately for pipes on Windows.
    
    See https://ghc.haskell.org/trac/ghc/ticket/13497#comment:17
    
    Until now, the program
    
      import System.IO
      main = hWaitForInput stdin (5 * 1000)
    
    didn't wait 5 seconds for input on Winodws, it terminated immediately.
    
    This was because the `PeekNamedPipe()` function introduced in commit
    94fee9e7 really only peeks, it doesn't block.  So if there's no data,
    `fdReady(fd, msec)` would return immediately even when the given `msec`
    timeout is not zero.
    
    This commit fixes it by looping around `PeekNamedPipe()` with a `sleep(1
    ms)`.
    
    Apparently there's no better way to do this on Windows without switching
    to IOCP.
    
    In any case, this change should be strictly better than what was there
    before.
    
    Reviewers: bgamari, austin, hvr
    
    Reviewed By: bgamari
    
    Subscribers: Phyx, rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3956


>---------------------------------------------------------------

66240c9bc77408f841e8cf974d44580434fb1a48
 libraries/base/cbits/inputReady.c | 46 +++++++++++++++++++++++++--------------
 1 file changed, 30 insertions(+), 16 deletions(-)

diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c
index ab2a1c2..ddeee66 100644
--- a/libraries/base/cbits/inputReady.c
+++ b/libraries/base/cbits/inputReady.c
@@ -17,6 +17,9 @@
  * descriptor 'fd' within 'msecs' milliseconds (or indefinitely if 'msecs' is
  * negative). "Input is available" is defined as 'can I safely read at least a
  * *character* from this file object without blocking?'
+ *
+ * This function blocks until either `msecs` have passed, or input is
+ * available.
  */
 int
 fdReady(int fd, int write, int msecs, int isSock)
@@ -100,7 +103,7 @@ fdReady(int fd, int write, int msecs, int isSock)
     } else {
         DWORD rc;
         HANDLE hFile = (HANDLE)_get_osfhandle(fd);
-        DWORD avail;
+        DWORD avail = 0;
 
         Time remaining = MSToTime(msecs);
 
@@ -187,23 +190,34 @@ fdReady(int fd, int write, int msecs, int isSock)
                 // WaitForMultipleObjects() doesn't work for pipes (it
                 // always returns WAIT_OBJECT_0 even when no data is
                 // available).  If the HANDLE is a pipe, therefore, we try
-                // PeekNamedPipe:
+                // PeekNamedPipe():
                 //
-                rc = PeekNamedPipe( hFile, NULL, 0, NULL, &avail, NULL );
-                if (rc != 0) {
-                    if (avail != 0) {
-                        return 1;
+                // PeekNamedPipe() does not block, so if it returns that
+                // there is no new data, we have to sleep and try again.
+                while (avail == 0) {
+                    rc = PeekNamedPipe( hFile, NULL, 0, NULL, &avail, NULL );
+                    if (rc != 0) {
+                        if (avail != 0) {
+                            return 1;
+                        } else { // no new data
+                            if (msecs > 0) {
+                                Time now = getProcessElapsedTime();
+                                if (now >= endTime) return 0;
+                                Sleep(1); // 1 millisecond (smallest possible time on Windows)
+                                continue;
+                            } else {
+                                return 0;
+                            }
+                        }
                     } else {
-                        return 0;
-                    }
-                } else {
-                    rc = GetLastError();
-                    if (rc == ERROR_BROKEN_PIPE) {
-                        return 1; // this is probably what we want
-                    }
-                    if (rc != ERROR_INVALID_HANDLE && rc != ERROR_INVALID_FUNCTION) {
-                        maperrno();
-                        return -1;
+                        rc = GetLastError();
+                        if (rc == ERROR_BROKEN_PIPE) {
+                            return 1; // this is probably what we want
+                        }
+                        if (rc != ERROR_INVALID_HANDLE && rc != ERROR_INVALID_FUNCTION) {
+                            maperrno();
+                            return -1;
+                        }
                     }
                 }
                 /* PeekNamedPipe didn't work - fall through to the general case */