[commit: base] ghc-7.4: Refactor findTempName: factor out file creation. (84c4102)

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : ghc-7.4

http://hackage.haskell.org/trac/ghc/changeset/84c41020a2c286c5e37a7ecd72ddf45a57fba4cf

>---------------------------------------------------------------

commit 84c41020a2c286c5e37a7ecd72ddf45a57fba4cf
Author: Paolo Capriotti <[email protected]>
Date:   Thu Jun 7 10:51:27 2012 +0100

    Refactor findTempName: factor out file creation.
    
    Add openNewFile function, which creates a new file and returns a file
    descriptor for it.
    
    MERGED from commit cd94cd74527ff3d812a083d903f68c1f9bd571b2

>---------------------------------------------------------------

 System/IO.hs |   64 +++++++++++++++++++++++++++++++++++----------------------
 1 files changed, 39 insertions(+), 25 deletions(-)

diff --git a/System/IO.hs b/System/IO.hs
index 1eb9271..860d2b6 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -563,13 +563,6 @@ openTempFile' loc tmp_dir template binary mode = do
          _                      -> error "bug in System.IO.openTempFile"
 
 #ifndef __NHC__
-    oflags1 = rw_flags .|. o_EXCL
-
-    binary_flags
-      | binary    = o_BINARY
-      | otherwise = 0
-
-    oflags = oflags1 .|. binary_flags
 #endif
 
 #if defined(__NHC__)
@@ -577,24 +570,19 @@ openTempFile' loc tmp_dir template binary mode = do
                         return (filepath, h)
 #elif defined(__GLASGOW_HASKELL__)
     findTempName x = do
-      fd <- withFilePath filepath $ \ f ->
-              c_open f oflags mode
-      if fd < 0
-       then do
-         errno <- getErrno
-         if errno == eEXIST
-           then findTempName (x+1)
-           else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
-       else do
-
-         (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
-                              False{-is_socket-} 
-                              True{-is_nonblock-}
-
-         enc <- getLocaleEncoding
-         h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
-
-         return (filepath, h)
+      r <- openNewFile filepath binary mode
+      case r of
+        FileExists -> findTempName (x + 1)
+        OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+        NewFileCreated fd -> do
+          (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+                               False{-is_socket-}
+                               True{-is_nonblock-}
+
+          enc <- getLocaleEncoding
+          h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
+
+          return (filepath, h)
 #else
          h <- fdToHandle fd `onException` c_close fd
          return (filepath, h)
@@ -615,6 +603,32 @@ openTempFile' loc tmp_dir template binary mode = do
         fdToHandle fd   = openFd (fromIntegral fd) False ReadWriteMode binary
 #endif
 
+#if defined(__GLASGOW_HASKELL__)
+data OpenNewFileResult
+  = NewFileCreated CInt
+  | FileExists
+  | OpenNewError Errno
+
+openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
+openNewFile filepath binary mode = do
+  let oflags1 = rw_flags .|. o_EXCL
+
+      binary_flags
+        | binary    = o_BINARY
+        | otherwise = 0
+
+      oflags = oflags1 .|. binary_flags
+  fd <- withFilePath filepath $ \ f ->
+          c_open f oflags mode
+  if fd < 0
+    then do
+      errno <- getErrno
+      if errno == eEXIST
+        then return FileExists
+        else return (OpenNewError errno)
+    else return (NewFileCreated fd)
+#endif
+
 -- XXX Should use filepath library
 pathSeparator :: Char
 #ifdef mingw32_HOST_OS