X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FFD.hs;h=173088561f68e5841f57c7eae39e1f69708ed35b;hb=57b9366e5fd3db86719d12b45320e6145b040fa6;hp=b5392d477d1df5ca57b9997d2dbd25eb7c9bc613;hpb=41e8fba828acbae1751628af50849f5352b27873;p=ghc-base.git

diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs
index b5392d4..1730885 100644
--- a/GHC/IO/FD.hs
+++ b/GHC/IO/FD.hs
@@ -139,10 +139,14 @@ writeBuf' fd buf = do
 -- opening files
 
 -- | Open a file and make an 'FD' for it.  Truncates the file to zero
--- size when the `IOMode` is `WriteMode`.  Puts the file descriptor
--- into non-blocking mode on Unix systems.
-openFile :: FilePath -> IOMode -> IO (FD,IODeviceType)
-openFile filepath iomode =
+-- size when the `IOMode` is `WriteMode`.
+openFile
+  :: FilePath -- ^ file to open
+  -> IOMode   -- ^ mode in which to open the file
+  -> Bool     -- ^ open the file in non-blocking mode?
+  -> IO (FD,IODeviceType)
+
+openFile filepath iomode non_blocking =
   withFilePath filepath $ \ f ->
 
     let 
@@ -162,7 +166,10 @@ openFile filepath iomode =
       binary_flags = 0
 #endif      
 
-      oflags = oflags1 .|. binary_flags
+      oflags2 = oflags1 .|. binary_flags
+
+      oflags | non_blocking = oflags2 .|. nonblock_flags
+             | otherwise    = oflags2
     in do
 
     -- the old implementation had a complicated series of three opens,
@@ -171,11 +178,12 @@ openFile filepath iomode =
     -- always returns EISDIR if the file is a directory and was opened
     -- for writing, so I think we're ok with a single open() here...
     fd <- throwErrnoIfMinus1Retry "openFile"
-                (c_open f oflags 0o666)
+                (if non_blocking then c_open      f oflags 0o666
+                                 else c_safe_open f oflags 0o666)
 
     (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}
                             False{-not a socket-} 
-                            True{-is non-blocking-}
+                            non_blocking
             `catchAny` \e -> do _ <- c_close fd
                                 throwIO e
 
@@ -191,13 +199,14 @@ openFile filepath iomode =
     return (fD,fd_type)
 
 std_flags, output_flags, read_flags, write_flags, rw_flags,
-    append_flags :: CInt
-std_flags    = o_NONBLOCK   .|. o_NOCTTY
+    append_flags, nonblock_flags :: CInt
+std_flags    = o_NOCTTY
 output_flags = std_flags    .|. o_CREAT
 read_flags   = std_flags    .|. o_RDONLY 
 write_flags  = output_flags .|. o_WRONLY
 rw_flags     = output_flags .|. o_RDWR
 append_flags = write_flags  .|. o_APPEND
+nonblock_flags = o_NONBLOCK
 
 
 -- | Make a 'FD' from an existing file descriptor.  Fails if the FD