diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2023-04-18 20:37:00 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-04-18 20:38:57 +0200 |
commit | c400e2b11cd5bfe7bd19def3e10318338f8db224 (patch) | |
tree | 60509728d1a0c335cba9f9c89407884700373d42 | |
parent | 95e2468b3c92e6689a5de4a2c03a79b3ef035f8b (diff) |
Command-line option to keep test directory
-rw-r--r-- | src/Main.hs | 5 | ||||
-rw-r--r-- | src/Run.hs | 2 | ||||
-rw-r--r-- | src/Run/Monad.hs | 2 |
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" @@ -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 |