diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-08-02 21:02:44 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-08-02 21:05:55 +0200 |
commit | c3efce4ff72f6284b1036df27edddbe0eae8026b (patch) | |
tree | a29a3baa04df2331568653e4470c9d816e11f229 /src | |
parent | 542e518ddd09ad9e4b44f17185d97b9f5ee943f1 (diff) |
Module name declaration
Changelog: Accept module name declaration
Diffstat (limited to 'src')
-rw-r--r-- | src/Main.hs | 6 | ||||
-rw-r--r-- | src/Parser.hs | 29 | ||||
-rw-r--r-- | src/Parser/Expr.hs | 2 | ||||
-rw-r--r-- | src/Test.hs | 6 |
4 files changed, 32 insertions, 11 deletions
diff --git a/src/Main.hs b/src/Main.hs index 594de0c..61afbd8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -149,10 +149,10 @@ main = do out <- startOutput (optVerbose opts) useColor tests <- forM files $ \(path, mbTestName) -> do - fileTests <- parseTestFile path + Module { .. } <- parseTestFile path return $ case mbTestName of - Nothing -> fileTests - Just name -> filter ((==name) . testName) fileTests + Nothing -> moduleTests + Just name -> filter ((==name) . testName) moduleTests ok <- allM (runTest out $ optTest opts) $ concat $ replicate (optRepeat opts) $ concat tests diff --git a/src/Parser.hs b/src/Parser.hs index 830093f..9029e0f 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -6,14 +6,18 @@ module Parser ( import Control.Monad.State -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.IO qualified as TL import Text.Megaparsec hiding (State) import System.Exit +import System.FilePath import Parser.Core +import Parser.Expr import Parser.Statement import Test @@ -24,19 +28,28 @@ parseTestDefinition = label "test definition" $ toplevel $ do wsymbol "test" lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':') -parseTestDefinitions :: TestParser [Test] -parseTestDefinitions = do - tests <- many parseTestDefinition +parseTestModule :: Text -> TestParser Module +parseTestModule defaultName = do + moduleName <- choice + [ label "module declaration" $ do + wsymbol "module" + x <- identifier + (x:) <$> many (symbol "." >> identifier) + , do + return $ [ defaultName ] + ] + moduleTests <- many parseTestDefinition eof - return tests + return Module { .. } -parseTestFile :: FilePath -> IO [Test] +parseTestFile :: FilePath -> IO Module parseTestFile path = do content <- TL.readFile path let initState = TestParserState { testVars = [] , testContext = SomeExpr RootNetwork } - case evalState (runParserT parseTestDefinitions path content) initState of + defaultModuleName = T.pack $ takeBaseName path + case evalState (runParserT (parseTestModule defaultModuleName) path content) initState of Left err -> putStr (errorBundlePretty err) >> exitFailure Right tests -> return tests diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index 894856e..fee5c25 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -1,4 +1,6 @@ module Parser.Expr ( + identifier, + varName, newVarName, addVarName, diff --git a/src/Test.hs b/src/Test.hs index d080cae..7f698a2 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -1,4 +1,5 @@ module Test ( + Module(..), Test(..), TestStep(..), SourceLine(..), @@ -30,6 +31,11 @@ import {-# SOURCE #-} Network import {-# SOURCE #-} Process import Util +data Module = Module + { moduleName :: [ Text ] + , moduleTests :: [ Test ] + } + data Test = Test { testName :: Text , testSteps :: [TestStep] |