[commit: unix] master: allow some syscalls in System.Posix.Directory to return EINTR (#5184) (b7b180d)

[Simon Marlow]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b7b180d23472dca03fb4c809cd86bcd6d3f01ea9

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

commit b7b180d23472dca03fb4c809cd86bcd6d3f01ea9
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Tue May 10 11:16:55 2011 +0100

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

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

 System/Posix/Directory.hsc |   10 ++++++----
 System/Posix/Error.hs      |    7 ++++++-
 2 files changed, 12 insertions(+), 5 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
@@ -46,7 +46,9 @@ import Foreign.C
 createDirectory :: FilePath -> FileMode -> IO ()
 createDirectory name mode =
   withCString name $ \s -> 
-    throwErrnoPathIfMinus1_ "createDirectory" name (c_mkdir s mode)  
+    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 at .
 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