make hGetBufNonBlocking do something on Windows w/ -threaded

hGetBufNonBlocking will behave the same as hGetBuf on Windows now, which
is better than just crashing (which it did previously).

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 18bf135..d938e7b 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -594,7 +594,7 @@ writeRawBufferPtr loc fd is_stream buf off len
 
 -- ToDo: we don't have a non-blocking primitve read on Win32
 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
-readRawBufferNoBlock = readRawBufferNoBlock
+readRawBufferNoBlock = readRawBuffer
 
 -- Async versions of the read/write primitives, for the non-threaded RTS
 

diff --git a/GHC/IO.hs b/GHC/IO.hs
index ca5a23e..f248914 100644 (file)
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -910,12 +910,13 @@ readChunkNonBlocking fd is_stream ptr bytes = do
                 else throwErrno "readChunk"
       else return r
 #else
-    (ssize, rc) <- asyncRead fd (fromIntegral $ fromEnum is_stream)
-                              (fromIntegral bytes) ptr
-    let r = fromIntegral ssize :: Int
-    if r == (-1)
-     then ioError (errnoToIOError "hGetBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing)
-     else return r
+    fromIntegral `liftM`
+        readRawBufferPtr "readChunkNonBlocking" (fromIntegral fd) is_stream 
+                           (castPtr ptr) 0 (fromIntegral bytes)
+
+    -- we don't have non-blocking read support on Windows, so just invoke
+    -- the ordinary low-level read which will block until data is available,
+    -- but won't wait for the whole buffer to fill.
 #endif
 
 slurpFile :: FilePath -> IO (Ptr (), Int)