From adb8b4d67356c4eca92f62fd1b7c1ac8add4241c Mon Sep 17 00:00:00 2001
From: Phil Ruffwind <rf@rufflewind.com>
Date: Wed, 10 Mar 2021 01:25:13 -0800
Subject: [PATCH] Fix CreateDirectoryIfMissing001 racing tests on OS X
It seems that, on the flavor of Mac OS X available on GitHub Actions,
InvalidArgument can be thrown by mkdir (createDirectory) when
createDirectoryIfMissing is raced against removeDirectoryRecursive.
---
System/Directory/Internal/Prelude.hs | 1 +
System/Directory/Internal/Windows.hsc | 4 ++++
directory.cabal | 2 +-
tests/CreateDirectoryIfMissing001.hs | 5 ++++-
4 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/System/Directory/Internal/Prelude.hs b/System/Directory/Internal/Prelude.hs
index 8ac315c7..c5843b03 100644
--- a/System/Directory/Internal/Prelude.hs
+++ b/System/Directory/Internal/Prelude.hs
@@ -129,6 +129,7 @@ import Foreign.C
import GHC.IO.Exception
( IOErrorType
( InappropriateType
+ , InvalidArgument
, OtherError
, UnsupportedOperation
)
diff --git a/System/Directory/Internal/Windows.hsc b/System/Directory/Internal/Windows.hsc
index d0ab3794..fc5de0c3 100644
--- a/System/Directory/Internal/Windows.hsc
+++ b/System/Directory/Internal/Windows.hsc
@@ -579,10 +579,14 @@ setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
setTimes path' (atime', mtime') =
bracket (openFileHandle path' Win32.gENERIC_WRITE)
Win32.closeHandle $ \ handle ->
+#if MIN_VERSION_Win32(2,12,0)
+ Win32.setFileTime handle Nothing (posixToWindowsTime <$> atime') (posixToWindowsTime <$> mtime')
+#else
maybeWith with (posixToWindowsTime <$> atime') $ \ atime'' ->
maybeWith with (posixToWindowsTime <$> mtime') $ \ mtime'' ->
Win32.failIf_ not "" $
Win32.c_SetFileTime handle nullPtr atime'' mtime''
+#endif
-- | Open the handle of an existing file or directory.
openFileHandle :: String -> Win32.AccessMode -> IO Win32.HANDLE
diff --git a/directory.cabal b/directory.cabal
index 916c5ce5..44937cd3 100644
--- a/directory.cabal
+++ b/directory.cabal
@@ -58,7 +58,7 @@ Library
time >= 1.4 && < 1.12,
filepath >= 1.3 && < 1.5
if os(windows)
- build-depends: Win32 >= 2.2.2 && < 2.12
+ build-depends: Win32 >= 2.2.2 && < 2.13
else
build-depends: unix >= 2.5.1 && < 2.9
diff --git a/tests/CreateDirectoryIfMissing001.hs b/tests/CreateDirectoryIfMissing001.hs
index b89f361d..c16db6f8 100644
--- a/tests/CreateDirectoryIfMissing001.hs
+++ b/tests/CreateDirectoryIfMissing001.hs
@@ -81,7 +81,10 @@ main _t = do
-- (see bug #2924 on GHC Trac)
create =
createDirectoryIfMissing True testdir_a `catch` \ e ->
- if isDoesNotExistError e || isPermissionError e || isInappropriateTypeError e
+ if isDoesNotExistError e
+ || isPermissionError e
+ || isInappropriateTypeError e
+ || ioeGetErrorType e == InvalidArgument
then return ()
else ioError e
--
GitLab