diff options
| -rw-r--r-- | src/Parser/Statement.hs | 6 | ||||
| -rw-r--r-- | src/Test/Builtins.hs | 14 |
2 files changed, 13 insertions, 7 deletions
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 912366b..67ffd76 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -312,11 +312,6 @@ testSpawn = command "spawn" $ Spawn <*> paramOrContext "on" <*> innerBlock -testSend :: TestParser [TestStep] -testSend = command "send" $ Send - <$> paramOrContext "to" - <*> param "" - testExpect :: TestParser [TestStep] testExpect = command "expect" $ Expect <$> cmdLine @@ -376,7 +371,6 @@ testStep = choice , testSubnet , testNode , testSpawn - , testSend , testExpect , testFlush , testDisconnectNode diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs index 3f42335..774ad70 100644 --- a/src/Test/Builtins.hs +++ b/src/Test/Builtins.hs @@ -3,13 +3,16 @@ module Test.Builtins ( ) where import Data.Map qualified as M +import Data.Text (Text) import Data.Typeable +import Process (Process) import Test builtins :: [ ( VarName, SomeVarValue ) ] builtins = - [ ( VarName "guard", builtinGuard ) + [ ( VarName "send", builtinSend ) + , ( VarName "guard", builtinGuard ) , ( VarName "wait", builtinWait ) ] @@ -19,6 +22,15 @@ getArg (FunctionArguments args) kw = Just (SomeExpr expr) | Just expr' <- cast expr -> expr' _ -> error "parameter mismatch" +builtinSend :: SomeVarValue +builtinSend = SomeVarValue (FunctionArguments $ M.fromList atypes) $ + \_ args -> TestBlock [ Send (getArg args (Just "to")) (getArg args Nothing) ] + where + atypes = + [ ( Just "to", SomeArgumentType (ContextDefault @Process) ) + , ( Nothing, SomeArgumentType (NoDefault @Text) ) + ] + builtinGuard :: SomeVarValue builtinGuard = SomeVarValue (FunctionArguments $ M.singleton Nothing (SomeArgumentType (NoDefault @Bool))) $ \sline args -> TestBlock [ Guard sline (getArg args Nothing) ] |