make hGetBufNonBlocking do something on Windows w/ -threaded
authorSimon Marlow <simonmar@microsoft.com>
Wed, 27 Sep 2006 14:58:11 +0000 (14:58 +0000)
committerSimon Marlow <simonmar@microsoft.com>
Wed, 27 Sep 2006 14:58:11 +0000 (14:58 +0000)
hGetBufNonBlocking will behave the same as hGetBuf on Windows now, which
is better than just crashing (which it did previously).

libraries/base/GHC/Handle.hs
libraries/base/GHC/IO.hs

index 18bf135..d938e7b 100644 (file)
@@ -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
 
index ca5a23e..f248914 100644 (file)
@@ -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)