add test for createDirectoryIfMissing (#2808)
authorSimon Marlow <marlowsd@gmail.com>
Wed, 26 Nov 2008 11:56:06 +0000 (11:56 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Wed, 26 Nov 2008 11:56:06 +0000 (11:56 +0000)
tests/all.T
tests/createDirectoryIfMissing001.hs [new file with mode: 0644]
tests/createDirectoryIfMissing001.stdout [new file with mode: 0644]

index 975e128..9455ef8 100644 (file)
@@ -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 (file)
index 0000000..6925e80
--- /dev/null
@@ -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 (file)
index 0000000..ce98f76
--- /dev/null
@@ -0,0 +1,6 @@
+()
+createDirectory001/a: createDirectory: does not exist (No such file or directory)
+()
+()
+()
+()