From 671d3c183d17d018a865455190caca32a9cde3f2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 2 Dec 2022 21:21:00 +0100
Subject: Place test directory beside config file

---
 src/Main.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index 286e09c..211be8d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -41,6 +41,7 @@ import Util
 data Options = Options
     { optDefaultTool :: String
     , optProcTools :: [(ProcName, String)]
+    , optTestDir :: FilePath
     , optVerbose :: Bool
     , optTimeout :: Scientific
     , optGDB :: Bool
@@ -51,16 +52,13 @@ defaultOptions :: Options
 defaultOptions = Options
     { optDefaultTool = ""
     , optProcTools = []
+    , optTestDir = ".test"
     , optVerbose = False
     , optTimeout = 1
     , optGDB = False
     , optForce = False
     }
 
-testDir :: FilePath
-testDir = "./.test"
-
-
 data TestEnv = TestEnv
     { teOutput :: Output
     , teFailed :: TVar (Maybe Failed)
@@ -142,6 +140,7 @@ atomicallyTest act = do
 
 withNetwork :: (Network -> TestRun a) -> TestRun a
 withNetwork inner = do
+    testDir <- asks $ optTestDir . teOptions . fst
     net <- liftIO $ do
         callCommand "ip link add name br0 group 1 type bridge"
         callCommand "ip addr add 192.168.0.1/24 broadcast 192.168.0.255 dev br0"
@@ -340,6 +339,7 @@ evalSteps = mapM_ $ \case
 
 runTest :: Output -> Options -> Test -> IO Bool
 runTest out opts test = do
+    let testDir = optTestDir opts
     when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e ->
         if isDoesNotExistError e then return () else ioError e
     exists <- doesPathExist testDir
@@ -435,9 +435,14 @@ main = do
     envtool <- lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool ->
         return $ fromMaybe (error "No test tool defined") $ mbtool `mplus` (return . (baseDir </>) =<< configTool =<< config)
 
+    let initOpts = defaultOptions
+            { optDefaultTool = envtool
+            , optTestDir = normalise $ baseDir </> optTestDir defaultOptions
+            }
+
     args <- getArgs
     (opts, ofiles) <- case getOpt Permute options args of
-        (o, files, []) -> return (foldl (flip id) defaultOptions { optDefaultTool = envtool } o, files)
+        (o, files, []) -> return (foldl (flip id) initOpts o, files)
         (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
             where header = "Usage: erebos-tester [OPTION...]"
 
-- 
cgit v1.2.3