From bc348c7dd586887a05b4299aaff4488cc3f19bad Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 5 Jun 2016 14:33:53 +0200 Subject: [PATCH] TESTS: less side effects plz --- test/HPath/IO/CanonicalizePathSpec.hs | 7 +- .../IO/CopyDirRecursiveCollectFailuresSpec.hs | 20 +++-- .../HPath/IO/CopyDirRecursiveOverwriteSpec.hs | 25 ++++-- test/HPath/IO/CopyDirRecursiveSpec.hs | 16 +++- test/HPath/IO/CopyFileOverwriteSpec.hs | 22 +++-- test/HPath/IO/CopyFileSpec.hs | 16 +++- test/HPath/IO/CreateDirSpec.hs | 8 +- test/HPath/IO/CreateRegularFileSpec.hs | 10 ++- test/HPath/IO/CreateSymlinkSpec.hs | 8 +- test/HPath/IO/DeleteDirRecursiveSpec.hs | 9 +- test/HPath/IO/DeleteDirSpec.hs | 10 ++- test/HPath/IO/DeleteFileSpec.hs | 8 +- test/HPath/IO/GetDirsFilesSpec.hs | 8 +- test/HPath/IO/GetFileTypeSpec.hs | 9 +- test/HPath/IO/MoveFileOverwriteSpec.hs | 9 +- test/HPath/IO/MoveFileSpec.hs | 9 +- test/HPath/IO/RecreateSymlinkOverwriteSpec.hs | 8 +- test/HPath/IO/RecreateSymlinkSpec.hs | 9 +- test/HPath/IO/RenameFileSpec.hs | 9 +- test/Main.hs | 8 +- test/Utils.hs | 88 +++++++++++++++++-- 21 files changed, 262 insertions(+), 54 deletions(-) diff --git a/test/HPath/IO/CanonicalizePathSpec.hs b/test/HPath/IO/CanonicalizePathSpec.hs index d811720..fdf4745 100644 --- a/test/HPath/IO/CanonicalizePathSpec.hs +++ b/test/HPath/IO/CanonicalizePathSpec.hs @@ -17,6 +17,11 @@ import Utils +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CanonicalizePathSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -35,7 +40,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.canonicalizePath" $ do -- successes -- diff --git a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs index 25bd7e6..4fdd0a2 100644 --- a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs @@ -26,8 +26,16 @@ import System.Posix.Env.ByteString import Utils import qualified Data.ByteString as BS import Data.ByteString.UTF8 (toString) +import Data.IORef + ( + readIORef + ) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyDirRecursiveCollectFailuresSpec" + createTmpDir setupFiles :: IO () setupFiles = do @@ -115,18 +123,19 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do + tmpDir' <- getRawTmpDir copyDirRecursive' "inputDir" "outputDir" Strict CollectFailures (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "outputDir") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" @@ -161,9 +170,8 @@ spec = before_ setupFiles $ after_ cleanupFiles $ normalDirPerms "outputDir1/foo2/foo4" normalDirPerms "outputDir1/foo2/foo4/inputFile4" c <- allDirectoryContents' "outputDir1" - pwd <- fromJust <$> getEnv "PWD" - let shouldC = (fmap (\x -> pwd `BS.append` "/" `BS.append` - tmpDir `BS.append` x) + tmpDir' <- getRawTmpDir + let shouldC = (fmap (\x -> tmpDir' `BS.append` x) ["outputDir1" ,"outputDir1/foo2" ,"outputDir1/foo2/inputFile1" diff --git a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs index 4752e15..aa21a55 100644 --- a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs @@ -19,8 +19,17 @@ import System.Exit import System.Process import Utils import Data.ByteString.UTF8 (toString) +import Data.IORef + ( + readIORef + ) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyDirRecursiveOverwriteSpec" + createTmpDir + setupFiles :: IO () setupFiles = do @@ -81,7 +90,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyDirRecursive" $ do -- successes -- @@ -93,28 +102,30 @@ spec = before_ setupFiles $ after_ cleanupFiles $ removeDirIfExists "outputDir" it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do + tmpDir' <- getRawTmpDir copyDirRecursive' "inputDir" "outputDir" Overwrite FailEarly (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "outputDir") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do + tmpDir' <- getRawTmpDir (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "alreadyExistsD") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "alreadyExistsD") `shouldReturn` (ExitFailure 1) copyDirRecursive' "inputDir" "alreadyExistsD" Overwrite FailEarly (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "alreadyExistsD") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "alreadyExistsD") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" diff --git a/test/HPath/IO/CopyDirRecursiveSpec.hs b/test/HPath/IO/CopyDirRecursiveSpec.hs index a2b84ef..6002a95 100644 --- a/test/HPath/IO/CopyDirRecursiveSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveSpec.hs @@ -19,9 +19,18 @@ import System.Exit import System.Process import Utils import Data.ByteString.UTF8 (toString) +import Data.IORef + ( + readIORef + ) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyDirRecursiveSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" @@ -67,7 +76,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyDirRecursive" $ do -- successes -- @@ -79,13 +88,14 @@ spec = before_ setupFiles $ after_ cleanupFiles $ removeDirIfExists "outputDir" it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do + tmpDir' <- getRawTmpDir copyDirRecursive' "inputDir" "outputDir" Strict FailEarly (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "outputDir") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" diff --git a/test/HPath/IO/CopyFileOverwriteSpec.hs b/test/HPath/IO/CopyFileOverwriteSpec.hs index 8150a38..d3b80a4 100644 --- a/test/HPath/IO/CopyFileOverwriteSpec.hs +++ b/test/HPath/IO/CopyFileOverwriteSpec.hs @@ -18,6 +18,16 @@ import System.Exit import System.Process import Utils import Data.ByteString.UTF8 (toString) +import Data.IORef + ( + readIORef + ) + + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyFileOverwriteSpec" + createTmpDir setupFiles :: IO () @@ -51,7 +61,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyFile" $ do -- successes -- @@ -62,21 +72,23 @@ spec = before_ setupFiles $ after_ cleanupFiles $ removeFileIfExists "outputFile" it "copyFile (Overwrite), output file already exists, all clear" $ do + tmpDir' <- getRawTmpDir copyFile' "alreadyExists" "alreadyExists.bak" Strict copyFile' "inputFile" "alreadyExists" Overwrite - (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " - ++ toString tmpDir ++ "alreadyExists") + (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " + ++ toString tmpDir' ++ "alreadyExists") `shouldReturn` ExitSuccess removeFileIfExists "alreadyExists" copyFile' "alreadyExists.bak" "alreadyExists" Strict removeFileIfExists "alreadyExists.bak" it "copyFile (Overwrite), and compare" $ do + tmpDir' <- getRawTmpDir copyFile' "inputFile" "outputFile" Overwrite - (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " - ++ toString tmpDir ++ "outputFile") + (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " + ++ toString tmpDir' ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" diff --git a/test/HPath/IO/CopyFileSpec.hs b/test/HPath/IO/CopyFileSpec.hs index ce8c1a9..c2974e5 100644 --- a/test/HPath/IO/CopyFileSpec.hs +++ b/test/HPath/IO/CopyFileSpec.hs @@ -19,8 +19,17 @@ import System.Exit import System.Process import Utils import Data.ByteString.UTF8 (toString) +import Data.IORef + ( + readIORef + ) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyFileSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" @@ -51,7 +60,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyFile" $ do -- successes -- @@ -62,11 +71,12 @@ spec = before_ setupFiles $ after_ cleanupFiles $ removeFileIfExists "outputFile" it "copyFile (Strict), and compare" $ do + tmpDir' <- getRawTmpDir copyFile' "inputFile" "outputFile" Strict - (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " - ++ toString tmpDir ++ "outputFile") + (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " + ++ toString tmpDir' ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" diff --git a/test/HPath/IO/CreateDirSpec.hs b/test/HPath/IO/CreateDirSpec.hs index 9fdf0ea..1172a78 100644 --- a/test/HPath/IO/CreateDirSpec.hs +++ b/test/HPath/IO/CreateDirSpec.hs @@ -15,6 +15,12 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CreateDirSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createDir' "alreadyExists" @@ -35,7 +41,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.createDir" $ do -- successes -- diff --git a/test/HPath/IO/CreateRegularFileSpec.hs b/test/HPath/IO/CreateRegularFileSpec.hs index 0cacc35..be02e59 100644 --- a/test/HPath/IO/CreateRegularFileSpec.hs +++ b/test/HPath/IO/CreateRegularFileSpec.hs @@ -15,6 +15,12 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CreateRegularFileSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" @@ -23,8 +29,6 @@ setupFiles = do noPerms "noPerms" noWritableDirPerms "noWritePerms" - - cleanupFiles :: IO () cleanupFiles = do normalDirPerms "noPerms" @@ -35,7 +39,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.createRegularFile" $ do -- successes -- diff --git a/test/HPath/IO/CreateSymlinkSpec.hs b/test/HPath/IO/CreateSymlinkSpec.hs index 81bebad..5720568 100644 --- a/test/HPath/IO/CreateSymlinkSpec.hs +++ b/test/HPath/IO/CreateSymlinkSpec.hs @@ -15,6 +15,12 @@ import GHC.IO.Exception import Utils +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CreateSymlinkSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" @@ -34,7 +40,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.createSymlink" $ do -- successes -- diff --git a/test/HPath/IO/DeleteDirRecursiveSpec.hs b/test/HPath/IO/DeleteDirRecursiveSpec.hs index 34a528b..7027f9c 100644 --- a/test/HPath/IO/DeleteDirRecursiveSpec.hs +++ b/test/HPath/IO/DeleteDirRecursiveSpec.hs @@ -19,6 +19,13 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "DeleteDirRecursiveSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -44,7 +51,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.deleteDirRecursive" $ do -- successes -- diff --git a/test/HPath/IO/DeleteDirSpec.hs b/test/HPath/IO/DeleteDirSpec.hs index def02f7..a5a444d 100644 --- a/test/HPath/IO/DeleteDirSpec.hs +++ b/test/HPath/IO/DeleteDirSpec.hs @@ -19,6 +19,14 @@ import GHC.IO.Exception import Utils + + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "DeleteDirSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -44,7 +52,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.deleteDir" $ do -- successes -- diff --git a/test/HPath/IO/DeleteFileSpec.hs b/test/HPath/IO/DeleteFileSpec.hs index e0b646d..f985485 100644 --- a/test/HPath/IO/DeleteFileSpec.hs +++ b/test/HPath/IO/DeleteFileSpec.hs @@ -20,6 +20,12 @@ import GHC.IO.Exception import Utils +upTmpDir :: IO () +upTmpDir = do + setTmpDir "DeleteFileSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "foo" @@ -40,7 +46,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.deleteFile" $ do -- successes -- diff --git a/test/HPath/IO/GetDirsFilesSpec.hs b/test/HPath/IO/GetDirsFilesSpec.hs index 2840e2d..daf3fe4 100644 --- a/test/HPath/IO/GetDirsFilesSpec.hs +++ b/test/HPath/IO/GetDirsFilesSpec.hs @@ -21,6 +21,12 @@ import GHC.IO.Exception import Utils +upTmpDir :: IO () +upTmpDir = do + setTmpDir "GetDirsFilesSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -47,7 +53,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.getDirsFiles" $ do -- successes -- diff --git a/test/HPath/IO/GetFileTypeSpec.hs b/test/HPath/IO/GetFileTypeSpec.hs index 7369687..7b63df5 100644 --- a/test/HPath/IO/GetFileTypeSpec.hs +++ b/test/HPath/IO/GetFileTypeSpec.hs @@ -16,6 +16,13 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "GetFileTypeSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "regularfile" @@ -40,7 +47,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.getFileType" $ do -- successes -- diff --git a/test/HPath/IO/MoveFileOverwriteSpec.hs b/test/HPath/IO/MoveFileOverwriteSpec.hs index 3450f81..6d2767e 100644 --- a/test/HPath/IO/MoveFileOverwriteSpec.hs +++ b/test/HPath/IO/MoveFileOverwriteSpec.hs @@ -17,6 +17,13 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "MoveFileOverwriteSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -44,7 +51,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.moveFile" $ do -- successes -- diff --git a/test/HPath/IO/MoveFileSpec.hs b/test/HPath/IO/MoveFileSpec.hs index 80fa9d2..a28d48f 100644 --- a/test/HPath/IO/MoveFileSpec.hs +++ b/test/HPath/IO/MoveFileSpec.hs @@ -17,6 +17,13 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "MoveFileSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -46,7 +53,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.moveFile" $ do -- successes -- diff --git a/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs b/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs index 959ef3a..896b509 100644 --- a/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs +++ b/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs @@ -20,6 +20,12 @@ import GHC.IO.Exception import Utils +upTmpDir :: IO () +upTmpDir = do + setTmpDir "RecreateSymlinkOverwriteSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -52,7 +58,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.recreateSymlink" $ do -- successes -- diff --git a/test/HPath/IO/RecreateSymlinkSpec.hs b/test/HPath/IO/RecreateSymlinkSpec.hs index 2d01307..1653ac3 100644 --- a/test/HPath/IO/RecreateSymlinkSpec.hs +++ b/test/HPath/IO/RecreateSymlinkSpec.hs @@ -19,6 +19,13 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "RecreateSymlinkSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -47,7 +54,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.recreateSymlink" $ do -- successes -- diff --git a/test/HPath/IO/RenameFileSpec.hs b/test/HPath/IO/RenameFileSpec.hs index 4809819..72f1e63 100644 --- a/test/HPath/IO/RenameFileSpec.hs +++ b/test/HPath/IO/RenameFileSpec.hs @@ -16,6 +16,13 @@ import GHC.IO.Exception import Utils + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "RenameFileSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -44,7 +51,7 @@ cleanupFiles = do spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.renameFile" $ do -- successes -- diff --git a/test/Main.hs b/test/Main.hs index 021a5d2..360bc4d 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -14,10 +14,6 @@ main :: IO () main = hspecWith defaultConfig { configFormatter = Just progress } - $ before_ up - $ after_ down + $ beforeAll_ createBaseTmpDir + $ afterAll_ deleteBaseTmpDir $ Spec.spec - where - up = createTmpDir - down = deleteTmpDir - diff --git a/test/Utils.hs b/test/Utils.hs index f27305a..ad5f41a 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -11,7 +11,20 @@ import Control.Applicative ) import Control.Monad ( - void + forM_ + , void + ) +import qualified Data.ByteString as BS +import Data.IORef + ( + newIORef + , readIORef + , writeIORef + , IORef + ) +import GHC.IO.Unsafe + ( + unsafePerformIO ) import HPath.IO import HPath.IO.Errors @@ -51,8 +64,13 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB -tmpDir :: ByteString -tmpDir = "test/HPath/IO/tmp/" +baseTmpDir :: ByteString +baseTmpDir = "test/HPath/IO/tmp/" + + +tmpDir :: IORef ByteString +{-# NOINLINE tmpDir #-} +tmpDir = unsafePerformIO (newIORef baseTmpDir) @@ -61,31 +79,63 @@ tmpDir = "test/HPath/IO/tmp/" ----------------- +setTmpDir :: ByteString -> IO () +{-# NOINLINE setTmpDir #-} +setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs) + + createTmpDir :: IO () +{-# NOINLINE createTmpDir #-} createTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir void $ createDir (pwd P. tmp) deleteTmpDir :: IO () +{-# NOINLINE deleteTmpDir #-} deleteTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir + void $ deleteDir (pwd P. tmp) + + +createBaseTmpDir :: IO () +{-# NOINLINE createBaseTmpDir #-} +createBaseTmpDir = do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + tmp <- P.parseRel baseTmpDir + void $ createDir (pwd P. tmp) + + +deleteBaseTmpDir :: IO () +{-# NOINLINE deleteBaseTmpDir #-} +deleteBaseTmpDir = do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + tmp <- P.parseRel baseTmpDir + contents <- getDirsFiles (pwd P. tmp) + forM_ contents deleteDir void $ deleteDir (pwd P. tmp) withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a +{-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir f (pwd P. tmp) +getRawTmpDir :: IO ByteString +{-# NOINLINE getRawTmpDir #-} +getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs) + + withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a +{-# NOINLINE withTmpDir #-} withTmpDir ip f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir p <- (pwd P. tmp P.) <$> P.parseRel ip f p @@ -94,49 +144,58 @@ withTmpDir' :: ByteString -> ByteString -> (P.Path P.Abs -> P.Path P.Abs -> IO a) -> IO a +{-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir p1 <- (pwd P. tmp P.) <$> P.parseRel ip1 p2 <- (pwd P. tmp P.) <$> P.parseRel ip2 f p1 p2 removeFileIfExists :: ByteString -> IO () +{-# NOINLINE removeFileIfExists #-} removeFileIfExists bs = withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) removeDirIfExists :: ByteString -> IO () +{-# NOINLINE removeDirIfExists #-} removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) copyFile' :: ByteString -> ByteString -> CopyMode -> IO () +{-# NOINLINE copyFile' #-} copyFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) copyDirRecursive' :: ByteString -> ByteString -> CopyMode -> RecursiveMode -> IO () +{-# NOINLINE copyDirRecursive' #-} copyDirRecursive' inputDirP outputDirP cm rm = withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) createDir' :: ByteString -> IO () +{-# NOINLINE createDir' #-} createDir' dest = withTmpDir dest createDir createRegularFile' :: ByteString -> IO () +{-# NOINLINE createRegularFile' #-} createRegularFile' dest = withTmpDir dest createRegularFile createSymlink' :: ByteString -> ByteString -> IO () +{-# NOINLINE createSymlink' #-} createSymlink' dest sympoint = withTmpDir dest (\x -> createSymlink x sympoint) renameFile' :: ByteString -> ByteString -> IO () +{-# NOINLINE renameFile' #-} renameFile' inputFileP outputFileP = withTmpDir' inputFileP outputFileP $ \i o -> do renameFile i o @@ -144,6 +203,7 @@ renameFile' inputFileP outputFileP = moveFile' :: ByteString -> ByteString -> CopyMode -> IO () +{-# NOINLINE moveFile' #-} moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do moveFile i o cm @@ -151,11 +211,13 @@ moveFile' inputFileP outputFileP cm = recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () +{-# NOINLINE recreateSymlink' #-} recreateSymlink' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) noWritableDirPerms :: ByteString -> IO () +{-# NOINLINE noWritableDirPerms #-} noWritableDirPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) perms where @@ -168,39 +230,48 @@ noWritableDirPerms path = withTmpDir path $ \p -> noPerms :: ByteString -> IO () +{-# NOINLINE noPerms #-} noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode normalDirPerms :: ByteString -> IO () +{-# NOINLINE normalDirPerms #-} normalDirPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms getFileType' :: ByteString -> IO FileType +{-# NOINLINE getFileType' #-} getFileType' path = withTmpDir path getFileType getDirsFiles' :: ByteString -> IO [P.Path P.Abs] +{-# NOINLINE getDirsFiles' #-} getDirsFiles' path = withTmpDir path getDirsFiles deleteFile' :: ByteString -> IO () +{-# NOINLINE deleteFile' #-} deleteFile' p = withTmpDir p deleteFile deleteDir' :: ByteString -> IO () +{-# NOINLINE deleteDir' #-} deleteDir' p = withTmpDir p deleteDir deleteDirRecursive' :: ByteString -> IO () +{-# NOINLINE deleteDirRecursive' #-} deleteDirRecursive' p = withTmpDir p deleteDirRecursive canonicalizePath' :: ByteString -> IO (P.Path P.Abs) +{-# NOINLINE canonicalizePath' #-} canonicalizePath' p = withTmpDir p canonicalizePath writeFile' :: ByteString -> ByteString -> IO () +{-# NOINLINE writeFile' #-} writeFile' ip bs = withTmpDir ip $ \p -> do fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing @@ -210,6 +281,7 @@ writeFile' ip bs = allDirectoryContents' :: ByteString -> IO [ByteString] +{-# NOINLINE allDirectoryContents' #-} allDirectoryContents' ip = withTmpDir ip $ \p -> allDirectoryContents (P.fromAbs p)