summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-01-02 22:57:25 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2023-01-02 23:01:37 +0100
commit1a5670d0fc6ee4640fc84b5abc01bf5efd85f5ce (patch)
tree19788ed4380088aff4e6e5906933b7d75ee29738
parenta5f0062f48fba018e7de8b5a3c0799381e535572 (diff)
Split command line and test options
-rw-r--r--src/Main.hs46
-rw-r--r--src/Run/Monad.hs12
2 files changed, 35 insertions, 23 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 1c1f03c..98fa9f1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -271,7 +271,7 @@ evalSteps = mapM_ $ \case
void $ liftIO $ getLine
outClearPrompt
-runTest :: Output -> Options -> Test -> IO Bool
+runTest :: Output -> TestOptions -> Test -> IO Bool
runTest out opts test = do
let testDir = optTestDir opts
when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e ->
@@ -335,30 +335,42 @@ runTest out opts test = do
return True
_ -> return False
+data CmdlineOptions = CmdlineOptions
+ { optTest :: TestOptions
+ , optVerbose :: Bool
+ }
-options :: [OptDescr (Options -> Options)]
+defaultCmdlineOptions :: CmdlineOptions
+defaultCmdlineOptions = CmdlineOptions
+ { optTest = defaultTestOptions
+ , optVerbose = False
+ }
+
+options :: [OptDescr (CmdlineOptions -> CmdlineOptions)]
options =
[ 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 }
+ (ReqArg (\str -> to $ \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 ['v'] ["verbose"]
(NoArg (\opts -> opts { optVerbose = True }))
"show output of processes and successful tests"
, Option ['t'] ["timeout"]
- (ReqArg (\str opts -> case readMaybe str of
- Just timeout -> opts { optTimeout = timeout }
- Nothing -> error "timeout must be a number") "SECONDS")
+ (ReqArg (\str -> to $ \opts -> case readMaybe str of
+ Just timeout -> opts { optTimeout = timeout }
+ Nothing -> error "timeout must be a number") "SECONDS")
"default timeout in seconds with microsecond precision"
, Option ['g'] ["gdb"]
- (NoArg (\opts -> opts { optGDB = True }))
+ (NoArg $ to $ \opts -> opts { optGDB = True })
"run GDB and attach spawned processes"
, Option ['f'] ["force"]
- (NoArg (\opts -> opts { optForce = True }))
+ (NoArg $ to $ \opts -> opts { optForce = True })
"remove test directory if it exists instead of stopping"
]
+ where
+ to f opts = opts { optTest = f (optTest opts) }
main :: IO ()
main = do
@@ -369,9 +381,11 @@ 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
+ let initOpts = defaultCmdlineOptions
+ { optTest = defaultTestOptions
+ { optDefaultTool = envtool
+ , optTestDir = normalise $ baseDir </> optTestDir defaultTestOptions
+ }
}
args <- getArgs
@@ -380,9 +394,9 @@ main = do
(_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
where header = "Usage: erebos-tester [OPTION...]"
- getPermissions (head $ words $ optDefaultTool opts) >>= \perms -> do
+ getPermissions (head $ words $ optDefaultTool $ optTest opts) >>= \perms -> do
when (not $ executable perms) $ do
- fail $ optDefaultTool opts <> " is not executable"
+ fail $ optDefaultTool (optTest opts) <> " is not executable"
files <- if not (null ofiles)
then return ofiles
@@ -390,5 +404,5 @@ main = do
when (null files) $ fail $ "No test files"
out <- startOutput $ optVerbose opts
- ok <- allM (runTest out opts) . concat =<< mapM parseTestFile files
+ ok <- allM (runTest out $ optTest opts) . concat =<< mapM parseTestFile files
when (not ok) exitFailure
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index 77e47ea..220ac46 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -2,7 +2,7 @@ module Run.Monad (
TestRun(..),
TestEnv(..),
TestState(..),
- Options(..), defaultOptions,
+ TestOptions(..), defaultTestOptions,
Failed(..),
) where
@@ -28,7 +28,7 @@ newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (Excep
data TestEnv = TestEnv
{ teOutput :: Output
, teFailed :: TVar (Maybe Failed)
- , teOptions :: Options
+ , teOptions :: TestOptions
, teProcesses :: MVar [Process]
, teGDB :: Maybe (MVar GDB)
}
@@ -39,22 +39,20 @@ data TestState = TestState
, tsNodePacketLoss :: Map NodeName Scientific
}
-data Options = Options
+data TestOptions = TestOptions
{ optDefaultTool :: String
, optProcTools :: [(ProcName, String)]
, optTestDir :: FilePath
- , optVerbose :: Bool
, optTimeout :: Scientific
, optGDB :: Bool
, optForce :: Bool
}
-defaultOptions :: Options
-defaultOptions = Options
+defaultTestOptions :: TestOptions
+defaultTestOptions = TestOptions
{ optDefaultTool = ""
, optProcTools = []
, optTestDir = ".test"
- , optVerbose = False
, optTimeout = 1
, optGDB = False
, optForce = False