From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 4 Feb 2009 16:33:19 +0000 (+0000)
Subject: fix this test for the new version of createDirectoryIfMissing (#2808)
X-Git-Tag: 2009-06-25~16
X-Git-Url: http://git.megacz.com/?p=haskell-directory.git;a=commitdiff_plain;h=8d5f972af5feea0b973630ad98cf2073868f061d

fix this test for the new version of createDirectoryIfMissing (#2808)
- add another race test, for two threads both doing create;cleanup
- ignore isDoesNotExistErrors in create
---

diff --git a/tests/createDirectoryIfMissing001.hs b/tests/createDirectoryIfMissing001.hs
index c4d5a39..6f26a39 100644
--- a/tests/createDirectoryIfMissing001.hs
+++ b/tests/createDirectoryIfMissing001.hs
@@ -5,6 +5,7 @@ import Control.Monad
 import Control.Exception
 import System.Directory
 import System.FilePath
+import System.IO.Error hiding (try)
 
 testdir = "createDirectoryIfMissing001.d"
 testdir_a = testdir </> "a"
@@ -34,9 +35,18 @@ main = do
   forkIO $ do replicateM_ 10000 create; putMVar m ()
   forkIO $ do replicateM_ 10000 cleanup; putMVar m ()
   replicateM_ 2 $ takeMVar m
+
+-- This test fails on Windows; see #2924
+--  replicateM_ 2 $ 
+--     forkIO $ do replicateM_ 5000 (do create; cleanup); putMVar m ()
+--  replicateM_ 2 $ takeMVar m
+
   cleanup
 
-create = createDirectoryIfMissing True testdir_a
+-- createDirectoryIfMissing is allowed to fail with isDoesNotExistError if
+-- another process/thread removes one of the directories during the proces
+-- of creating the hierarchy.
+create = tryJust (guard . isDoesNotExistError) $ createDirectoryIfMissing True testdir_a
 
 cleanup = ignore $ removeDirectoryRecursive testdir