summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-11-03 22:02:30 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2022-11-08 21:08:38 +0100
commit4a737645b8e14b2857b11ee705438e30eef9e5bd (patch)
treeadbcf40cc6aed3463b9dcb9737eb741376bab86a
parente5f02ede3595239e6ca8705a54db42857266ab84 (diff)
Force flag to remove existing test directory
-rw-r--r--src/Main.hs10
1 files changed, 10 insertions, 0 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 60040b0..40ee8a8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -22,6 +22,7 @@ import System.Directory
import System.Environment
import System.Exit
import System.FilePath
+import System.IO.Error
import System.Posix.Process
import System.Posix.Signals
import System.Process
@@ -39,6 +40,7 @@ data Options = Options
, optVerbose :: Bool
, optTimeout :: Scientific
, optGDB :: Bool
+ , optForce :: Bool
}
defaultOptions :: Options
@@ -48,6 +50,7 @@ defaultOptions = Options
, optVerbose = False
, optTimeout = 1
, optGDB = False
+ , optForce = False
}
testDir :: FilePath
@@ -356,6 +359,10 @@ runTest out opts test = do
<$> pure (error "network not initialized")
<*> pure []
<*> pure M.empty
+
+ when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e ->
+ if isDoesNotExistError e then return () else ioError e
+
(fmap $ either (const False) id) $ runExceptT $ flip runReaderT (tenv, tstate) $ fromTestRun $ initNetwork $ \net -> do
let sigHandler SignalInfo { siginfoSpecific = chld } = do
processes <- readMVar (netProcesses net)
@@ -401,6 +408,9 @@ options =
, Option ['g'] ["gdb"]
(NoArg (\opts -> opts { optGDB = True }))
"run GDB and attach spawned processes"
+ , Option ['f'] ["force"]
+ (NoArg (\opts -> opts { optForce = True }))
+ "remove test directory if it exists instead of stopping"
]
main :: IO ()