summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-04-18 20:37:00 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-04-18 20:38:57 +0200
commitc400e2b11cd5bfe7bd19def3e10318338f8db224 (patch)
tree60509728d1a0c335cba9f9c89407884700373d42
parent95e2468b3c92e6689a5de4a2c03a79b3ef035f8b (diff)
Command-line option to keep test directory
-rw-r--r--src/Main.hs5
-rw-r--r--src/Run.hs2
-rw-r--r--src/Run/Monad.hs2
3 files changed, 7 insertions, 2 deletions
diff --git a/src/Main.hs b/src/Main.hs
index c9fbf50..7af4c72 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -56,7 +56,10 @@ options =
"run GDB and attach spawned processes"
, Option ['f'] ["force"]
(NoArg $ to $ \opts -> opts { optForce = True })
- "remove test directory if it exists instead of stopping"
+ "remove test directory if it already exists instead of stopping"
+ , Option ['k'] ["keep"]
+ (NoArg $ to $ \opts -> opts { optKeep = True })
+ "keep test directory even if all tests succeed"
, Option ['V'] ["version"]
(NoArg $ \opts -> opts { optShowVersion = True })
"show version and exit"
diff --git a/src/Run.hs b/src/Run.hs
index 5b0ac2e..f54a38c 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -94,7 +94,7 @@ runTest out opts test = do
failed <- atomically $ readTVar (teFailed tenv)
case (res, failed) of
(Right (), Nothing) -> do
- removeDirectoryRecursive testDir
+ when (not $ optKeep opts) $ removeDirectoryRecursive testDir
return True
_ -> return False
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index 5b55897..1036749 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -53,6 +53,7 @@ data TestOptions = TestOptions
, optTimeout :: Scientific
, optGDB :: Bool
, optForce :: Bool
+ , optKeep :: Bool
}
defaultTestOptions :: TestOptions
@@ -63,6 +64,7 @@ defaultTestOptions = TestOptions
, optTimeout = 1
, optGDB = False
, optForce = False
+ , optKeep = False
}
data Failed = Failed