Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cd94cd74527ff3d812a083d903f68c1f9bd571b2 >--------------------------------------------------------------- commit cd94cd74527ff3d812a083d903f68c1f9bd571b2 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. >--------------------------------------------------------------- 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
