[commit: packages/directory] master: Accept InappropriateType in CreateDirectoryIfMissing001 races (7fc4aef)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/directory

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7fc4aef33f43153db35de66bad17cc98e1bc7db2/directory

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

commit 7fc4aef33f43153db35de66bad17cc98e1bc7db2
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Wed Sep 2 05:26:23 2015 -0400

    Accept InappropriateType in CreateDirectoryIfMissing001 races
    
    For some reason, racing directory creation and removal in
    CreateDirectoryIfMissing001 causes failures due to "InappropriateType"
    (ENOTDIR).  The issue is very perplexing and I've not yet found the
    actual cause.  Here's what I do know:
    
     0. Hasn't occurred until threading was enabled (-threaded; +RTS -N2).
    
     1. Doesn't seem to occur on Travis unless containers are used.
    
     2. I could reproduce it on tmpfs.
    
     3. ENOTDIR can be detected by a simple C program that runs mkdir
        repeatedly while the cabal test is running.  However, I couldn't
        reproduce it using just two C programs, one running mkdir repeatedly
        and another running rmdir repeatedly.
    
     4. Seems to be more likely to occur in older GHC versions.


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

7fc4aef33f43153db35de66bad17cc98e1bc7db2
 tests/CreateDirectoryIfMissing001.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/tests/CreateDirectoryIfMissing001.hs b/tests/CreateDirectoryIfMissing001.hs
index c3cb7eb..339585d 100644
--- a/tests/CreateDirectoryIfMissing001.hs
+++ b/tests/CreateDirectoryIfMissing001.hs
@@ -90,7 +90,7 @@ main _t = do
     -- (see bug #2924 on GHC Trac)
     create =
       createDirectoryIfMissing True testdir_a `E.catch` \ e ->
-      if isDoesNotExistError e || isPermissionError e
+      if isDoesNotExistError e || isPermissionError e || isInappropriateTypeError e
       then return ()
       else ioError e
 
@@ -102,7 +102,10 @@ main _t = do
 #ifdef mingw32_HOST_OS
     isNotADirectoryError = isAlreadyExistsError
 #else
-    isNotADirectoryError e = case ioeGetErrorType e of
-      InappropriateType -> True
-      _                 -> False
+    isNotADirectoryError = isInappropriateTypeError
 #endif
+
+    isInappropriateTypeError = isInappropriateTypeErrorType . ioeGetErrorType
+
+    isInappropriateTypeErrorType InappropriateType = True
+    isInappropriateTypeErrorType _                 = False