1 module Main(main) where
3 import Control.Concurrent
5 import Control.Exception
6 import System.Directory
8 import System.IO.Error hiding (try)
10 testdir = "createDirectoryIfMissing001.d"
11 testdir_a = testdir </> "a"
16 report $ createDirectoryIfMissing False testdir
19 report $ createDirectoryIfMissing False testdir_a
20 -- should fail with does not exist
22 report $ createDirectoryIfMissing True testdir_a
23 -- should succeed with no error
24 report $ createDirectoryIfMissing False testdir_a
25 -- should succeed with no error
26 report $ createDirectoryIfMissing False (addTrailingPathSeparator testdir_a)
27 -- should succeed with no error
30 report $ createDirectoryIfMissing True (addTrailingPathSeparator testdir_a)
32 -- look for race conditions: #2808. This fails with
33 -- +RTS -N2 and directory 1.0.0.2.
35 forkIO $ do replicateM_ 10000 create; putMVar m ()
36 forkIO $ do replicateM_ 10000 cleanup; putMVar m ()
37 replicateM_ 2 $ takeMVar m
39 -- This test fails on Windows; see #2924
41 -- forkIO $ do replicateM_ 5000 (do create; cleanup); putMVar m ()
42 -- replicateM_ 2 $ takeMVar m
46 -- createDirectoryIfMissing is allowed to fail with isDoesNotExistError if
47 -- another process/thread removes one of the directories during the proces
48 -- of creating the hierarchy.
49 create = tryJust (guard . isDoesNotExistError) $ createDirectoryIfMissing True testdir_a
51 cleanup = ignore $ removeDirectoryRecursive testdir
53 report :: Show a => IO a -> IO ()
57 Left e -> print (e :: SomeException)
60 ignore :: IO a -> IO ()
64 Left e -> let _ = e :: SomeException in return ()