Skip to content
Snippets Groups Projects
Commit b7b180d2 authored by Simon Marlow's avatar Simon Marlow
Browse files

allow some syscalls in System.Posix.Directory to return EINTR (#5184)

parent cdf2106d
No related branches found
No related tags found
No related merge requests found
......@@ -45,8 +45,10 @@ import Foreign.C
-- @mode@.
createDirectory :: FilePath -> FileMode -> IO ()
createDirectory name mode =
withCString name $ \s ->
throwErrnoPathIfMinus1_ "createDirectory" name (c_mkdir s mode)
withCString name $ \s ->
throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode)
-- POSIX doesn't allow mkdir() to return EINTR, but it does on
-- OS X (#5184), so we need the Retry variant here.
foreign import ccall unsafe "mkdir"
c_mkdir :: CString -> CMode -> IO CInt
......@@ -58,7 +60,7 @@ newtype DirStream = DirStream (Ptr CDir)
openDirStream :: FilePath -> IO DirStream
openDirStream name =
withCString name $ \s -> do
dirp <- throwErrnoPathIfNull "openDirStream" name $ c_opendir s
dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
return (DirStream dirp)
foreign import ccall unsafe "__hsunix_opendir"
......@@ -115,7 +117,7 @@ foreign import ccall unsafe "rewinddir"
-- the directory stream @dp@.
closeDirStream :: DirStream -> IO ()
closeDirStream (DirStream dirp) = do
throwErrnoIfMinus1_ "closeDirStream" (c_closedir dirp)
throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)
foreign import ccall unsafe "closedir"
c_closedir :: Ptr CDir -> IO CInt
......@@ -190,7 +192,7 @@ foreign import ccall unsafe "rmdir"
changeWorkingDirectoryFd :: Fd -> IO ()
changeWorkingDirectoryFd (Fd fd) =
throwErrnoIfMinus1_ "changeWorkingDirectoryFd" (c_fchdir fd)
throwErrnoIfMinus1Retry_ "changeWorkingDirectoryFd" (c_fchdir fd)
foreign import ccall unsafe "fchdir"
c_fchdir :: CInt -> IO CInt
......@@ -21,7 +21,8 @@ module System.Posix.Error (
throwErrnoPathIfNullRetry,
throwErrnoPathIfMinus1,
throwErrnoPathIfMinus1_,
throwErrnoPathIfMinus1Retry
throwErrnoPathIfMinus1Retry,
throwErrnoPathIfMinus1Retry_
) where
import Foreign
......@@ -31,6 +32,10 @@ throwErrnoPathIfMinus1Retry :: Num a => String -> FilePath -> IO a -> IO a
throwErrnoPathIfMinus1Retry loc path f =
throwErrnoPathIfRetry (== -1) loc path f
throwErrnoPathIfMinus1Retry_ :: Num a => String -> FilePath -> IO a -> IO ()
throwErrnoPathIfMinus1Retry_ loc path f =
void $ throwErrnoPathIfRetry (== -1) loc path f
throwErrnoPathIfNullRetry :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
throwErrnoPathIfNullRetry loc path f =
throwErrnoPathIfRetry (== nullPtr) loc path f
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment