summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-08-02 21:02:44 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-08-02 21:05:55 +0200
commitc3efce4ff72f6284b1036df27edddbe0eae8026b (patch)
treea29a3baa04df2331568653e4470c9d816e11f229
parent542e518ddd09ad9e4b44f17185d97b9f5ee943f1 (diff)
Module name declaration
Changelog: Accept module name declaration
-rw-r--r--src/Main.hs6
-rw-r--r--src/Parser.hs29
-rw-r--r--src/Parser/Expr.hs2
-rw-r--r--src/Test.hs6
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]