tests/createDirectoryIfMissing001.hs

   1 module Main(main) where
   2
   3 import Control.Concurrent
   4 import Control.Monad
   5 import Control.Exception
   6 import System.Directory
   7 import System.FilePath
   8
   9 testdir = "createDirectoryIfMissing001.d"
  10 testdir_a = testdir </> "a"
  11
  12 main = do
  13   cleanup
  14
  15   report $ createDirectoryIfMissing False testdir
  16   cleanup
  17
  18   report $ createDirectoryIfMissing False testdir_a
  19    -- should fail with does not exist
  20
  21   report $ createDirectoryIfMissing True testdir_a
  22    -- should succeed with no error
  23   report $ createDirectoryIfMissing False testdir_a
  24    -- should succeed with no error
  25   report $ createDirectoryIfMissing False (addTrailingPathSeparator testdir_a)
  26    -- should succeed with no error
  27
  28   cleanup
  29   report $ createDirectoryIfMissing True (addTrailingPathSeparator testdir_a)
  30
  31   -- look for race conditions: #2808.  This fails with
  32   -- +RTS -N2 and directory 1.0.0.2.
  33   m <- newEmptyMVar
  34   forkIO $ do replicateM_ 10000 create; putMVar m ()
  35   forkIO $ do replicateM_ 10000 cleanup; putMVar m ()
  36   replicateM_ 2 $ takeMVar m
  37   cleanup
  38
  39 create = createDirectoryIfMissing True testdir_a
  40
  41 cleanup = ignore $ removeDirectoryRecursive testdir
  42
  43 report :: Show a => IO a -> IO ()
  44 report io = do
  45   r <- try io
  46   case r of
  47    Left e  -> print (e :: SomeException)
  48    Right a -> print a
  49
  50 ignore :: IO a -> IO ()
  51 ignore io = do
  52   r <- try io
  53   case r of
  54    Left e  -> let _ = e :: SomeException in return ()
  55    Right a -> return ()