From 2a4f1f973f167e396d8cc3ef8a29e16f8fdc5229 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 20 Dec 2021 21:57:37 +0100
Subject: Test tools defined optionally per-proc on command line

---
 src/Main.hs | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index c7be179..712d2b1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,6 +6,7 @@ import Control.Concurrent.STM
 import Control.Monad
 
 import Data.List
+import Data.Maybe
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
@@ -42,12 +43,16 @@ data Node = Node
     }
 
 data Options = Options
-    { optGDB :: Bool
+    { optDefaultTool :: String
+    , optProcTools :: [(ProcName, String)]
+    , optGDB :: Bool
     }
 
 defaultOptions :: Options
 defaultOptions = Options
-    { optGDB = False
+    { optDefaultTool = ""
+    , optProcTools = []
+    , optGDB = False
     }
 
 testDir :: FilePath
@@ -230,9 +235,9 @@ allM :: Monad m => [a] -> (a -> m Bool) -> m Bool
 allM (x:xs) p = p x >>= \case True -> allM xs p; False -> return False
 allM [] _ = return True
 
-runTest :: Output -> String -> Bool -> Test -> IO ()
-runTest out tool useGDB test = do
-    net <- initNetwork out useGDB
+runTest :: Output -> Options -> Test -> IO ()
+runTest out opts test = do
+    net <- initNetwork out $ optGDB opts
 
     let sigHandler SignalInfo { siginfoSpecific = chld } = do
             processes <- readMVar (netProcesses net)
@@ -250,7 +255,8 @@ runTest out tool useGDB test = do
     ok <- allM (testSteps test) $ \case
         Spawn pname nname -> do
             node <- getNode net nname
-            void $ spawnOn out (Right node) pname Nothing tool
+            void $ spawnOn out (Right node) pname Nothing $
+                fromMaybe (optDefaultTool opts) (lookup pname $ optProcTools opts)
             return True
 
         Send pname line -> do
@@ -274,19 +280,27 @@ runTest out tool useGDB test = do
 
 options :: [OptDescr (Options -> Options)]
 options =
-     [ Option ['g'] ["gdb"]
+    [ Option ['T'] ["tool"]
+        (ReqArg (\str opts -> case break (==':') str of
+                                   (path, []) -> opts { optDefaultTool = path }
+                                   (pname, (_:path)) -> opts { optProcTools = (ProcName (T.pack pname), path) : optProcTools opts }
+                ) "PATH")
+        "test tool to be used"
+    , Option ['g'] ["gdb"]
         (NoArg (\opts -> opts { optGDB = True }))
         "run GDB and attach spawned pracesses"
-     ]
+    ]
 
 main :: IO ()
 main = do
-    tool <- getEnv "EREBOS_TEST_TOOL"
+    envtool <- fromMaybe (error "No test tool defined") <$> lookupEnv "EREBOS_TEST_TOOL"
     args <- getArgs
     (opts, files) <- case getOpt Permute options args of
-        (o, files, []) -> return (foldl (flip id) defaultOptions o, files)
+        (o, files, []) -> return (foldl (flip id) defaultOptions { optDefaultTool = envtool } o, files)
         (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
             where header = "Usage: erebos-tester [OPTION...]"
 
+    optDefaultTool opts `seq` return ()
+
     out <- startOutput
-    forM_ files $ mapM_ (runTest out tool (optGDB opts)) <=< parseTestFile
+    forM_ files $ mapM_ (runTest out opts) <=< parseTestFile
-- 
cgit v1.2.3