From b7b180d23472dca03fb4c809cd86bcd6d3f01ea9 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Tue, 10 May 2011 11:16:55 +0100
Subject: [PATCH] allow some syscalls in System.Posix.Directory to return EINTR
(#5184)
---
System/Posix/Directory.hsc | 12 +++++++-----
System/Posix/Error.hs | 7 ++++++-
2 files changed, 13 insertions(+), 6 deletions(-)
diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc
index 3f676ce..cb357df 100644
--- a/System/Posix/Directory.hsc
+++ b/System/Posix/Directory.hsc
@@ -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
diff --git a/System/Posix/Error.hs b/System/Posix/Error.hs
index cd4b91e..d0683c5 100644
--- a/System/Posix/Error.hs
+++ b/System/Posix/Error.hs
@@ -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
--
GitLab