diff options
| -rw-r--r-- | erebos-tester.cabal | 1 | ||||
| -rw-r--r-- | src/Parser.hs | 3 | ||||
| -rw-r--r-- | src/Parser/Core.hs | 3 | ||||
| -rw-r--r-- | src/Parser/Statement.hs | 12 | ||||
| -rw-r--r-- | src/Run.hs | 3 | ||||
| -rw-r--r-- | src/Test.hs | 21 | ||||
| -rw-r--r-- | src/Test/Builtins.hs | 13 |
7 files changed, 41 insertions, 15 deletions
diff --git a/erebos-tester.cabal b/erebos-tester.cabal index c9e90b5..b1afc76 100644 --- a/erebos-tester.cabal +++ b/erebos-tester.cabal @@ -87,6 +87,7 @@ executable erebos-tester-core Run Run.Monad Test + Test.Builtins Util Version Version.Git diff --git a/src/Parser.hs b/src/Parser.hs index 4fd60b5..405622e 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -22,6 +22,7 @@ import Parser.Core import Parser.Expr import Parser.Statement import Test +import Test.Builtins parseTestDefinition :: TestParser Test parseTestDefinition = label "test definition" $ toplevel $ do @@ -55,7 +56,7 @@ parseTestFile path = do content <- TL.readFile path absPath <- makeAbsolute path let initState = TestParserState - { testVars = [] + { testVars = map (fmap someVarValueType) builtins , testContext = SomeExpr RootNetwork } case evalState (runParserT (parseTestModule absPath) path content) initState of diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs index da93905..b932523 100644 --- a/src/Parser/Core.hs +++ b/src/Parser/Core.hs @@ -24,9 +24,6 @@ data TestParserState = TestParserState , testContext :: SomeExpr } -data SomeExpr = forall a. ExprType a => SomeExpr (Expr a) -data SomeExprType = forall a. ExprType a => SomeExprType (Proxy a) - someEmptyVar :: SomeExprType -> SomeVarValue someEmptyVar (SomeExprType (Proxy :: Proxy a)) = SomeVarValue $ emptyVarValue @a diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 8906cec..8dd285a 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -75,6 +75,11 @@ forStatement = do body <- testBlock indent return [For line tname (unpack <$> e) body] +exprStatement :: TestParser [ TestStep ] +exprStatement = do + expr <- typedExpr + return [ ExprStatement expr ] + class (Typeable a, Typeable (ParamRep a)) => ParamType a where type ParamRep a :: Type type ParamRep a = a @@ -335,11 +340,6 @@ testPacketLoss = command "packet_loss" $ PacketLoss <*> innerBlock -testWait :: TestParser [TestStep] -testWait = do - wsymbol "wait" - return [Wait] - testBlock :: Pos -> TestParser [TestStep] testBlock indent = concat <$> go where @@ -369,5 +369,5 @@ testStep = choice , testDisconnectNodes , testDisconnectUpstream , testPacketLoss - , testWait + , exprStatement ] @@ -32,6 +32,7 @@ import Output import Process import Run.Monad import Test +import Test.Builtins runTest :: Output -> TestOptions -> Test -> IO Bool runTest out opts test = do @@ -60,7 +61,7 @@ runTest out opts test = do } tstate = TestState { tsNetwork = error "network not initialized" - , tsVars = [] + , tsVars = builtins , tsNodePacketLoss = M.empty , tsDisconnectedUp = S.empty , tsDisconnectedBridge = S.empty diff --git a/src/Test.hs b/src/Test.hs index a54bbbd..e2f829b 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -7,8 +7,8 @@ module Test ( MonadEval(..), VarName(..), TypedVarName(..), textVarName, unpackVarName, - ExprType(..), - SomeVarValue(..), fromSomeVarValue, textSomeVarValue, + ExprType(..), SomeExpr(..), SomeExprType(..), someExprType, + SomeVarValue(..), fromSomeVarValue, textSomeVarValue, someVarValueType, RecordSelector(..), ExprListUnpacker(..), ExprEnumerator(..), @@ -135,9 +135,16 @@ instance ExprType TestBlock where textExprValue _ = "<test block>" emptyVarValue = TestBlock [] -data SomeVarValue = forall a. ExprType a => SomeVarValue a -data RecordSelector a = forall b. ExprType b => RecordSelector (a -> b) +data SomeExpr = forall a. ExprType a => SomeExpr (Expr a) + +data SomeExprType = forall a. ExprType a => SomeExprType (Proxy a) + +someExprType :: SomeExpr -> SomeExprType +someExprType (SomeExpr (_ :: Expr a)) = SomeExprType (Proxy @a) + + +data SomeVarValue = forall a. ExprType a => SomeVarValue a fromSomeVarValue :: forall a m. (ExprType a, MonadFail m) => VarName -> SomeVarValue -> m a fromSomeVarValue name (SomeVarValue value) = maybe (fail err) return $ cast value @@ -146,6 +153,12 @@ fromSomeVarValue name (SomeVarValue value) = maybe (fail err) return $ cast valu textSomeVarValue :: SomeVarValue -> Text textSomeVarValue (SomeVarValue value) = textExprValue value +someVarValueType :: SomeVarValue -> SomeExprType +someVarValueType (SomeVarValue (_ :: a)) = SomeExprType (Proxy @a) + + +data RecordSelector a = forall b. ExprType b => RecordSelector (a -> b) + data ExprListUnpacker a = forall e. ExprType e => ExprListUnpacker (a -> [e]) (Proxy a -> Proxy e) data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a]) diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs new file mode 100644 index 0000000..9deb2df --- /dev/null +++ b/src/Test/Builtins.hs @@ -0,0 +1,13 @@ +module Test.Builtins ( + builtins, +) where + +import Test + +builtins :: [ ( VarName, SomeVarValue ) ] +builtins = + [ ( VarName "wait", SomeVarValue builtinWait ) + ] + +builtinWait :: TestBlock +builtinWait = TestBlock [ Wait ] |