summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2026-05-27 20:40:06 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2026-05-31 13:48:13 +0200
commita7c646b2d61b1e23eb44b608b843f2673acaa5bd (patch)
tree8a5294947a1eb78b29ca03d48ba62fec07c2ecad /src
parentbbf1fd0846fa51f74ef01399ab005d4d847becce (diff)
Options to select and exclude tests in config file
Diffstat (limited to 'src')
-rw-r--r--src/Config.hs11
-rw-r--r--src/Main.hs3
-rw-r--r--src/Run.hs16
-rw-r--r--src/TestMode.hs14
4 files changed, 32 insertions, 12 deletions
diff --git a/src/Config.hs b/src/Config.hs
index adf0321..af2161a 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -9,6 +9,7 @@ import Control.Monad.Combinators
import Data.ByteString.Lazy qualified as BS
import Data.Scientific
+import Data.Text (Text)
import Data.Text qualified as T
import Data.YAML
@@ -21,6 +22,8 @@ data Config = Config
{ configDir :: FilePath
, configTool :: Maybe FilePath
, configTests :: [ Pattern ]
+ , configSelect :: Maybe [ Text ]
+ , configExclude :: [ Text ]
, configTimeout :: Maybe Scientific
}
deriving (Show)
@@ -33,6 +36,14 @@ instance FromYAML (FilePath -> Config) where
, m .:? "tests" .!= [] -- list of patterns
]
)
+ configSelect <- foldr1 (<|>)
+ [ fmap (Just . (: [])) (m .: "select") -- single item
+ , m .:? "select" -- list of items
+ ]
+ configExclude <- foldr1 (<|>)
+ [ fmap (: []) (m .: "exclude") -- single item
+ , m .:? "exclude" .!= [] -- list of items
+ ]
configTimeout <- fmap fromNumber <$> m .:! "timeout"
return $ \configDir -> Config {..}
diff --git a/src/Main.hs b/src/Main.hs
index b2e4171..7adf71d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -196,7 +196,8 @@ main = do
let tfSelect = if null otests then Nothing else Just otests
tfExclude = optExclude opts
- tests <- exitOnError $ filterTests TestFilter {..} lm
+ tfilter = maybe mempty testFilterFromConfig config <> TestFilter {..}
+ tests <- exitOnError $ filterTests tfilter lm
tcpdump <- case optCmdlineTcpdump opts of
TcpdumpAuto -> findExecutable "tcpdump"
diff --git a/src/Run.hs b/src/Run.hs
index e1bab46..f3805ea 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -7,6 +7,7 @@ module Run (
evalGlobalDefs,
TestFilter(..),
+ testFilterFromConfig,
filterTests,
) where
@@ -37,6 +38,7 @@ import System.Posix.Process
import System.Posix.Signals
import System.Process
+import Config
import GDB
import Network
import Network.Ip
@@ -185,6 +187,20 @@ data TestFilter = TestFilter
, tfExclude :: [ Text ]
}
+instance Semigroup TestFilter where
+ a <> b
+ | isJust (tfSelect b) = b
+ | otherwise = a { tfExclude = tfExclude a <> tfExclude b }
+
+instance Monoid TestFilter where
+ mempty = TestFilter Nothing []
+
+testFilterFromConfig :: Config -> TestFilter
+testFilterFromConfig Config {..} = TestFilter
+ { tfSelect = configSelect
+ , tfExclude = configExclude
+ }
+
filterTests :: TestFilter -> LoadedModules -> Either CustomTestError [ Test ]
filterTests TestFilter {..} LoadedModules {..} = do
let allTests = concatMap (\m -> ( moduleName m, ) <$> moduleTests m) lmModules
diff --git a/src/TestMode.hs b/src/TestMode.hs
index 6a74b10..22d8237 100644
--- a/src/TestMode.hs
+++ b/src/TestMode.hs
@@ -25,7 +25,6 @@ import Output
import Parser
import Run
import Script.Expr
-import Script.Module
import Test
@@ -109,7 +108,6 @@ commands =
[ ( "load", cmdLoad )
, ( "load-config", cmdLoadConfig )
, ( "run", cmdRun )
- , ( "run-all", cmdRunAll )
]
showError :: Text -> CustomTestError -> Command
@@ -157,19 +155,13 @@ cmdRun :: Command
cmdRun = do
params <- asks tmiParams
let ( select, exclude ) = fmap (map (T.drop 1)) $ partition (("^" /=) . T.take 1) params
+ pfilter = (TestFilter (if select == [ "*" ] then Nothing else Just select) exclude)
+ cfilter <- asks $ maybe mempty testFilterFromConfig . tmiConfig
Just lm <- gets tmsModules
- case filterTests (TestFilter (if select == [ "*" ] then Nothing else Just select) exclude) lm of
+ case filterTests (cfilter <> pfilter) lm of
Left err -> showError "run-failed" err
Right tests -> do
forM_ tests $ \test -> do
res <- runSingleTest test
cmdOut $ "run-test-result " <> testName test <> " " <> (if res then "done" else "failed")
cmdOut "run-done"
-
-cmdRunAll :: Command
-cmdRunAll = do
- Just LoadedModules {..} <- gets tmsModules
- forM_ (concatMap moduleTests lmModules) $ \test -> do
- res <- runSingleTest test
- cmdOut $ "run-test-result " <> testName test <> " " <> (if res then "done" else "failed")
- cmdOut "run-all-done"