From c3efce4ff72f6284b1036df27edddbe0eae8026b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 2 Aug 2024 21:02:44 +0200
Subject: Module name declaration
Changelog: Accept module name declaration
---
src/Main.hs | 6 +++---
src/Parser.hs | 29 +++++++++++++++++++++--------
src/Parser/Expr.hs | 2 ++
src/Test.hs | 6 ++++++
4 files changed, 32 insertions(+), 11 deletions(-)
(limited to 'src')
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]
--
cgit v1.2.3