Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6172212097337923b621be9e12b3542c34cad10e >--------------------------------------------------------------- commit 6172212097337923b621be9e12b3542c34cad10e Author: Paolo Capriotti <[email protected]> Date: Thu Jun 7 11:18:00 2012 +0100 Allow openTempFile to retry when it hits a directory (#4968). Windows returns an EACCES error instead of EEXIST when a call to `open` fails due to an existing directory, so add a special case for this situation. >--------------------------------------------------------------- System/IO.hs | 28 +++++++++++++++++++++++++--- cbits/Win32Utils.c | 6 ++++++ 2 files changed, 31 insertions(+), 3 deletions(-) diff --git a/System/IO.hs b/System/IO.hs index 860d2b6..57db1b0 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | @@ -240,6 +241,7 @@ import Data.Bits import Data.List import Data.Maybe import Foreign.C.Error +import Foreign.C.String import Foreign.C.Types import System.Posix.Internals import System.Posix.Types @@ -623,10 +625,30 @@ openNewFile filepath binary mode = do if fd < 0 then do errno <- getErrno - if errno == eEXIST - then return FileExists - else return (OpenNewError errno) + case errno of + _ | errno == eEXIST -> return FileExists +# ifdef mingw32_HOST_OS + -- If c_open throws EACCES on windows, it could mean that filepath is a + -- directory. In this case, we want to return FileExists so that the + -- enclosing openTempFile can try again instead of failing outright. + -- See bug #4968. + _ | errno == eACCES -> do + withCString filepath $ \path -> do + -- There is a race here: the directory might have been moved or + -- deleted between the c_open call and the next line, but there + -- doesn't seem to be any direct way to detect that the c_open call + -- failed because of an existing directory. + exists <- c_fileExists path + return $ if exists + then FileExists + else OpenNewError errno +# endif + _ -> return (OpenNewError errno) else return (NewFileCreated fd) + +# ifdef mingw32_HOST_OS +foreign import ccall "file_exists" c_fileExists :: CString -> IO Bool +# endif #endif -- XXX Should use filepath library diff --git a/cbits/Win32Utils.c b/cbits/Win32Utils.c index 7327f45..ecd54f3 100644 --- a/cbits/Win32Utils.c +++ b/cbits/Win32Utils.c @@ -127,4 +127,10 @@ int get_unique_file_info(int fd, HsWord64 *dev, HsWord64 *ino) return -1; } +BOOL file_exists(LPCTSTR path) +{ + DWORD r = GetFileAttributes(path); + return r != INVALID_FILE_ATTRIBUTES; +} + #endif _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
