From c400e2b11cd5bfe7bd19def3e10318338f8db224 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 18 Apr 2023 20:37:00 +0200
Subject: Command-line option to keep test directory

---
 src/Main.hs      | 5 ++++-
 src/Run.hs       | 2 +-
 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"
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
-- 
cgit v1.2.3