[commit: ghc] ghc-8.2: base: Fix hWaitForInput with timeout on POSIX (ae69eae)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/ae69eaed6e2a5dff7f3a61d4373b7c52e715e3ad/ghc

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

commit ae69eaed6e2a5dff7f3a61d4373b7c52e715e3ad
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Fri Apr 21 12:11:28 2017 -0400

    base: Fix hWaitForInput with timeout on POSIX
    
    This was previously broken (#13252) by
    f46369b8a1bf90a3bdc30f2b566c3a7e03672518, which ported the fdReady
    function from `select` to `poll` and in so doing dropping support for
    timeouts. Unfortunately, while `select` tells us the amount of time not
    slept (on Linux anyways; it turns out this is implementation dependent),
    `poll` does not give us this luxury. Consequently, we manually need to
    track time slept in this case.
    
    Unfortunately, portably measuring time is hard. Ideally we would use
    `clock_gettime` with the monotonic clock here, but sadly this isn't
    supported on most versions of Darwin. Consequently, we instead use
    `gettimeofday`, running the risk of system time changes messing us up.
    
    Test Plan: Validate
    
    Reviewers: simonmar, austin, hvr
    
    Reviewed By: simonmar
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #13252
    
    Differential Revision: https://phabricator.haskell.org/D3473
    
    (cherry picked from commit e5732d2a28dfb8a754ee73e124e3558222a543bb)


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

ae69eaed6e2a5dff7f3a61d4373b7c52e715e3ad
 libraries/base/cbits/inputReady.c | 40 +++++++++++++++++++++++++++++----------
 libraries/base/tests/T13525.hs    |  5 ++++-
 libraries/base/tests/all.T        |  2 +-
 3 files changed, 35 insertions(+), 12 deletions(-)

diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c
index 230e592..1530d5b 100644
--- a/libraries/base/cbits/inputReady.c
+++ b/libraries/base/cbits/inputReady.c
@@ -9,11 +9,13 @@
 #include "HsBase.h"
 #if !defined(_WIN32)
 #include <poll.h>
+#include <sys/time.h>
 #endif
 
 /*
  * inputReady(fd) checks to see whether input is available on the file
- * descriptor 'fd'.  Input meaning 'can I safely read at least a
+ * 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?'
  */
 int
@@ -21,23 +23,41 @@ fdReady(int fd, int write, int msecs, int isSock)
 {
 
 #if !defined(_WIN32)
+    struct pollfd fds[1];
 
-    // We only handle msecs == 0 on non-Windows, because this is the
-    // only case we need.  Non-zero waiting is handled by the IO manager.
-    if (msecs != 0) {
-        fprintf(stderr, "fdReady: msecs != 0, this shouldn't happen");
-        abort();
+    // if we need to track the then record the current time in case we are
+    // interrupted.
+    struct timeval tv0;
+    if (msecs > 0) {
+        if (gettimeofday(&tv0, NULL) != 0) {
+            fprintf(stderr, "fdReady: gettimeofday failed: %s\n",
+                    strerror(errno));
+            abort();
+        }
     }
 
-    struct pollfd fds[1];
-
     fds[0].fd = fd;
     fds[0].events = write ? POLLOUT : POLLIN;
     fds[0].revents = 0;
 
     int res;
-    while ((res = poll(fds, 1, 0)) < 0) {
-        if (errno != EINTR) {
+    while ((res = poll(fds, 1, msecs)) < 0) {
+        if (errno == EINTR) {
+            if (msecs > 0) {
+                struct timeval tv;
+                if (gettimeofday(&tv, NULL) != 0) {
+                    fprintf(stderr, "fdReady: gettimeofday failed: %s\n",
+                            strerror(errno));
+                    abort();
+                }
+
+                int elapsed = 1000 * (tv.tv_sec - tv0.tv_sec)
+                            + (tv.tv_usec - tv0.tv_usec) / 1000;
+                msecs -= elapsed;
+                if (msecs <= 0) return 0;
+                tv0 = tv;
+            }
+        } else {
             return (-1);
         }
     }
diff --git a/libraries/base/tests/T13525.hs b/libraries/base/tests/T13525.hs
index 1bb01b6..b4b589e 100644
--- a/libraries/base/tests/T13525.hs
+++ b/libraries/base/tests/T13525.hs
@@ -1,7 +1,10 @@
+import System.Posix.Files
 import System.IO
 import System.Timeout
 
 main :: IO ()
 main = do
-    hWaitForInput stdin (5 * 1000)
+    createNamedPipe "test" accessModes
+    h <- openFile "test" ReadMode
+    hWaitForInput h (5 * 1000)
     return ()
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 49298d3..b4bb74a 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -211,4 +211,4 @@ test('T13191',
         , only_ways(['normal'])],
       compile_and_run,
       ['-O'])
-test('T13525', expect_broken(13525), compile_and_run, [''])
+test('T13525', normal, compile_and_run, [''])