From: Simon Marlow <simonmar@microsoft.com>
Date: Wed, 27 Sep 2006 14:58:11 +0000 (+0000)
Subject: make hGetBufNonBlocking do something on Windows w/ -threaded
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=7a499a50c676e36e3d4562652e94fbcabf22e594;p=ghc-base.git

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
--- 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
--- 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)