From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 26 Nov 2008 11:56:06 +0000 (+0000)
Subject: add test for createDirectoryIfMissing (#2808)
X-Git-Tag: 2009-06-25~26
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=inline;h=ce7704ceb4ac4f68fa22b20019e3f77843351523;p=haskell-directory.git

add test for createDirectoryIfMissing (#2808)
---

diff --git a/tests/all.T b/tests/all.T
index 975e128..9455ef8 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -15,3 +15,5 @@ test('renameFile001', extra_clean(['renameFile001.tmp1','renameFile001.tmp2']),
       compile_and_run, [''])
 
 test('createDirectory001',  normal, compile_and_run, [''])
+
+test('createDirectoryIfMissing001',  normal, compile_and_run, [''])
diff --git a/tests/createDirectoryIfMissing001.hs b/tests/createDirectoryIfMissing001.hs
new file mode 100644
index 0000000..6925e80
--- /dev/null
+++ b/tests/createDirectoryIfMissing001.hs
@@ -0,0 +1,55 @@
+module Main(main) where
+
+import Control.Concurrent
+import Control.Monad
+import Control.Exception
+import System.Directory
+import System.FilePath
+
+testdir = "createDirectory001"
+testdir_a = testdir </> "a"
+
+main = do
+  cleanup
+
+  report $ createDirectoryIfMissing False testdir
+  cleanup
+
+  report $ createDirectoryIfMissing False testdir_a
+   -- should fail with does not exist
+
+  report $ createDirectoryIfMissing True testdir_a
+   -- should succeed with no error
+  report $ createDirectoryIfMissing False testdir_a
+   -- should succeed with no error
+  report $ createDirectoryIfMissing False (addTrailingPathSeparator testdir_a)
+   -- should succeed with no error
+
+  cleanup
+  report $ createDirectoryIfMissing True (addTrailingPathSeparator testdir_a)
+
+  -- look for race conditions: #2808.  This fails with
+  -- +RTS -N2 and directory 1.0.0.2.
+  m <- newEmptyMVar
+  forkIO $ do replicateM_ 10000 create; putMVar m ()
+  forkIO $ do replicateM_ 10000 cleanup; putMVar m ()
+  replicateM_ 2 $ takeMVar m
+  cleanup
+
+create = createDirectoryIfMissing True testdir_a
+
+cleanup = ignore $ removeDirectoryRecursive testdir
+
+report :: Show a => IO a -> IO ()
+report io = do
+  r <- try io
+  case r of
+   Left e  -> print (e :: SomeException)
+   Right a -> print a
+
+ignore :: IO a -> IO ()
+ignore io = do
+  r <- try io
+  case r of
+   Left e  -> let _ = e :: SomeException in return ()
+   Right a -> return ()
diff --git a/tests/createDirectoryIfMissing001.stdout b/tests/createDirectoryIfMissing001.stdout
new file mode 100644
index 0000000..ce98f76
--- /dev/null
+++ b/tests/createDirectoryIfMissing001.stdout
@@ -0,0 +1,6 @@
+()
+createDirectory001/a: createDirectory: does not exist (No such file or directory)
+()
+()
+()
+()