X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHandle.hs;h=e0b755f1050e2821595f9c3f938c8d2180677b26;hb=7a73aaf70fefb4b30c9159f5d15035f8e9c6e114;hp=52bf8cde99e4de0877b07139144ee74ea924c067;hpb=b674b3cdb447d2265dccc4e3c343c9625f464a33;p=haskell-directory.git

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 52bf8cd..e0b755f 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
 
@@ -936,10 +936,6 @@ openFd fd mb_fd_type is_socket filepath mode binary = do
 	RawDevice -> 
 		mkFileHandle fd is_socket filepath ha_type binary
 
-	_ ->
-	  ioException (IOError Nothing UnsupportedOperation "openFd"
-			           "unknown file type" Nothing) 
-
 fdToHandle :: FD -> IO Handle
 fdToHandle fd = do
    mode <- fdGetMode fd
@@ -973,6 +969,17 @@ mkStdHandle fd filepath ha_type buf bmode = do
 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
 mkFileHandle fd is_stream filepath ha_type binary = do
   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
+
+#ifdef mingw32_HOST_OS
+  -- On Windows, if this is a read/write handle and we are in text mode,
+  -- turn off buffering.  We don't correctly handle the case of switching
+  -- from read mode to write mode on a buffered text-mode handle, see bug
+  -- \#679.
+  bmode <- case ha_type of
+      		ReadWriteHandle | not binary -> return NoBuffering
+		_other			     -> return bmode
+#endif
+
   spares <- newIORef BufferListNil
   newFileHandle filepath (handleFinalizer filepath)
 	    (Handle__ { haFD = fd,
@@ -1558,9 +1565,10 @@ dupHandle other_side h_ = do
 
 dupHandleTo other_side hto_ h_ = do
   flushBuffer h_
-  new_fd <- throwErrnoIfMinus1 "dupHandleTo" $ 
-	        c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_))
-  dupHandle_ other_side h_ new_fd
+  -- Windows' dup2 does not return the new descriptor, unlike Unix
+  throwErrnoIfMinus1 "dupHandleTo" $ 
+	c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_))
+  dupHandle_ other_side h_ (haFD hto_)
 
 dupHandle_ other_side h_ new_fd = do
   buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))