From e56577e4506c7db72aef9e273cfa00592ca20829 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 17 Oct 2026 15:51:31 +0200 Subject: Do not look for config file in parent dirs in test mode --- src/Config.hs | 7 ++++--- src/Main.hs | 46 +++++++++++++++++++++------------------------- src/Run.hs | 6 ++++-- src/Run/Monad.hs | 8 ++++---- src/TestMode.hs | 4 ++-- 5 files changed, 35 insertions(+), 36 deletions(-) (limited to 'src') diff --git a/src/Config.hs b/src/Config.hs index 8555540..e243609 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -71,19 +71,20 @@ instance FromYAML ConfigTool where , ToolCabal <$> m .: "cabal" ] -findConfig :: IO (Maybe FilePath) -findConfig = go "." +findConfig :: Bool -> IO (Maybe FilePath) +findConfig tryParents = go "." where name = "erebos-tester.yaml" go path = do doesFileExist (path name) >>= \case True -> return $ Just $ path name - False -> doesDirectoryExist (path "..") >>= \case + False | tryParents -> doesDirectoryExist (path "..") >>= \case True -> do parent <- canonicalizePath $ path ".." if parent /= path then go parent else return Nothing False -> return Nothing + False -> return Nothing parseConfig :: FilePath -> IO Config parseConfig path = do diff --git a/src/Main.hs b/src/Main.hs index fc91b56..aada687 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,7 +4,6 @@ import Control.Monad import Control.Monad.Reader import Data.Char -import Data.Maybe import Data.Text (Text) import Data.Text qualified as T @@ -67,7 +66,7 @@ options :: [ OptDescr (CmdlineOptions -> CmdlineOptions) ] options = [ Option ['T'] ["tool"] (ReqArg (\str -> to $ \opts -> case break (== ':') str of - ( path, [] ) -> opts { optDefaultTool = ToolPath path } + ( path, [] ) -> opts { optDefaultTool = Just (ToolPath path) } ( pname, _ : path ) -> opts { optProcTools = ( ProcName (T.pack pname), ToolPath path ) : optProcTools opts } ) "") "test tool to be used" @@ -137,29 +136,9 @@ hiddenOptions = main :: IO () main = do - config <- mapM parseConfig =<< findConfig - let baseDir = maybe "." configDir config - - envtool <- lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool -> if - | Just envpath <- mbtool - -> return $ ToolPath envpath - | Just conftool <- configTool =<< config - -> case conftool of - ToolPath cpath -> return $ ToolPath $ baseDir cpath - ToolCabal ccabal -> return $ ToolCabal ccabal - | otherwise -> return $ error "No test tool defined" - - let initOpts = defaultCmdlineOptions - { optTest = defaultTestOptions - { optDefaultTool = envtool - , optTestDir = normalise $ baseDir optTestDir defaultTestOptions - , optTimeout = fromMaybe (optTimeout defaultTestOptions) $ configTimeout =<< config - } - } - args <- getArgs (opts, oselection) <- case getOpt Permute (options ++ hiddenOptions) args of - (o, files, []) -> return (foldl (flip id) initOpts o, files) + (o, files, []) -> return (foldl (flip id) defaultCmdlineOptions o, files) (_, _, errs) -> do hPutStrLn stderr $ concat errs <> "Try `erebos-tester --help' for more information." exitFailure @@ -185,11 +164,25 @@ main = do putStrLn versionLine exitSuccess + config <- mapM parseConfig =<< findConfig (not $ optTestMode opts) + let baseDir = maybe "." configDir config + when (optTestMode opts) $ do testMode config exitSuccess - case optDefaultTool $ optTest opts of + defaultTool <- case optDefaultTool $ optTest opts of + Just tool -> return tool + Nothing -> lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool -> if + | Just envpath <- mbtool + -> return $ ToolPath envpath + | Just conftool <- configTool =<< config + -> case conftool of + ToolPath cpath -> return $ ToolPath $ baseDir cpath + ToolCabal ccabal -> return $ ToolCabal ccabal + | otherwise -> fail "no test tool defined" + + case defaultTool of ToolPath tpath -> case words tpath of (path : _) -> getPermissions path >>= \perms -> do when (not $ executable perms) $ do @@ -227,7 +220,10 @@ main = do TcpdumpOff -> return Nothing let topts = (optTest opts) - { optTcpdump = tcpdump + { optDefaultTool = Just defaultTool + , optTestDir = normalise $ baseDir optTestDir defaultTestOptions + , optTimeout = optTimeout (optTest opts) `mplus` (configTimeout =<< config) + , optTcpdump = tcpdump } report@Report {..} <- runTests out topts lmGlobalDefs tests diff --git a/src/Run.hs b/src/Run.hs index a1184c4..53a0275 100644 --- a/src/Run.hs +++ b/src/Run.hs @@ -124,7 +124,7 @@ runTest out opts gdefs test = do objIdVar <- newMVar 1 procIdVar <- newMVar 1 procVar <- newMVar [] - timeoutVar <- newMVar ( optTimeout opts, 0 ) + timeoutVar <- newMVar ( fromMaybe 1 $ optTimeout opts, 0 ) let evalTool = \case ToolPath path -> return path @@ -139,7 +139,9 @@ runTest out opts gdefs test = do ioError $ userError $ "failed to find ‘" <> T.unpack name <> "’ executable path using cabal" | otherwise -> return $ T.unpack arg - defaultTool <- evalTool $ optDefaultTool opts + defaultTool <- case optDefaultTool opts of + Just tool -> evalTool tool + Nothing -> ioError $ userError "No test tool defined" procTools <- mapM (sequence . fmap evalTool) $ optProcTools opts mgdb <- if optGDB opts diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs index d204f09..10d6ab1 100644 --- a/src/Run/Monad.hs +++ b/src/Run/Monad.hs @@ -64,10 +64,10 @@ data TestState = TestState } data TestOptions = TestOptions - { optDefaultTool :: ConfigTool + { optDefaultTool :: Maybe ConfigTool , optProcTools :: [ ( ProcName, ConfigTool ) ] , optTestDir :: FilePath - , optTimeout :: Scientific + , optTimeout :: Maybe Scientific , optTcpdump :: Maybe FilePath , optGDB :: Bool , optForce :: Bool @@ -80,10 +80,10 @@ data TestOptions = TestOptions defaultTestOptions :: TestOptions defaultTestOptions = TestOptions - { optDefaultTool = ToolPath "" + { optDefaultTool = Nothing , optProcTools = [] , optTestDir = ".test" - , optTimeout = 1 + , optTimeout = Nothing , optTcpdump = Nothing , optGDB = False , optForce = False diff --git a/src/TestMode.hs b/src/TestMode.hs index 22481f4..220aa0b 100644 --- a/src/TestMode.hs +++ b/src/TestMode.hs @@ -4,12 +4,12 @@ module TestMode ( testMode, ) where +import Control.Monad import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State import Data.List -import Data.Maybe import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T @@ -84,7 +84,7 @@ runTestsC tests = do Just LoadedModules {..} <- gets tmsModules mbconfig <- asks tmiConfig let opts = defaultTestOptions - { optDefaultTool = fromMaybe (ToolPath "/bin/true") $ configTool =<< mbconfig + { optDefaultTool = (configTool =<< mbconfig) `mplus` Just (ToolPath "/bin/true") , optTestDir = ".test" <> show num , optKeep = True , optKeepGoing = True -- cgit v1.2.3