diff options
| -rw-r--r-- | src/Main.hs | 2 | ||||
| -rw-r--r-- | src/Run.hs | 6 | ||||
| -rw-r--r-- | src/Script/Expr.hs | 1 | ||||
| -rw-r--r-- | src/TestMode.hs | 5 |
4 files changed, 10 insertions, 4 deletions
diff --git a/src/Main.hs b/src/Main.hs index 3285bee..619c4a5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -193,7 +193,7 @@ main = do | otherwise = OutputStyleQuiet out <- startOutput outputStyle useColor - ( modules, globalDefs ) <- loadModules (map fst files) + ( modules, _, globalDefs ) <- loadModules (map fst files) tests <- filter ((`notElem` optExclude opts) . testName) <$> if null otests then fmap concat $ forM (zip modules files) $ \( Module {..}, ( filePath, mbTestName )) -> do case mbTestName of @@ -142,7 +142,7 @@ runTest out opts gdefs test = do return False -loadModules :: [ FilePath ] -> IO ( [ Module ], GlobalDefs ) +loadModules :: [ FilePath ] -> IO ( [ Module ], [ ( ( ModuleName, Text ), [ Tag ] ) ], GlobalDefs ) loadModules files = do ( modules, allModules ) <- parseTestFiles files >>= \case Right res -> do @@ -155,7 +155,9 @@ loadModules files = do putStrLn (showErrorComponent err) exitFailure let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules - return ( modules, globalDefs ) + evalTags test = map (\e -> runSimpleEval (eval e) globalDefs []) $ testTags test + tags = concatMap (\Module {..} -> map (\test -> ( ( moduleName, testName test ), evalTags test )) moduleTests) modules + return ( modules, tags, globalDefs ) evalGlobalDefs :: [ (( ModuleName, VarName ), SomeExpr ) ] -> GlobalDefs diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs index bff363c..09b7c80 100644 --- a/src/Script/Expr.hs +++ b/src/Script/Expr.hs @@ -4,6 +4,7 @@ module Script.Expr ( MonadEval(..), VariableDictionary, GlobalDefs, lookupVar, tryLookupVar, withVar, withTypedVar, eval, evalSome, evalSomeWith, + runSimpleEval, FunctionType, DynamicType, ExprType(..), SomeExpr(..), diff --git a/src/TestMode.hs b/src/TestMode.hs index 33f2493..d2cf00d 100644 --- a/src/TestMode.hs +++ b/src/TestMode.hs @@ -38,6 +38,7 @@ data TestModeInput = TestModeInput data TestModeState = TestModeState { tmsModules :: [ Module ] + , tmsTags :: [ ( ( ModuleName, Text ), [ Tag ] ) ] , tmsGlobals :: GlobalDefs , tmsNextTestNumber :: Int } @@ -45,6 +46,7 @@ data TestModeState = TestModeState initTestModeState :: TestModeState initTestModeState = TestModeState { tmsModules = mempty + , tmsTags = mempty , tmsGlobals = mempty , tmsNextTestNumber = 1 } @@ -147,9 +149,10 @@ cmdLoad = do cmdLoadConfig :: Command cmdLoadConfig = do Just config <- asks tmiConfig - ( modules, globalDefs ) <- liftIO $ loadModules =<< getConfigTestFiles config + ( modules, tags, globalDefs ) <- liftIO $ loadModules =<< getConfigTestFiles config modify $ \s -> s { tmsModules = modules + , tmsTags = tags , tmsGlobals = globalDefs } cmdOut "load-config-done" |