diff options
| -rw-r--r-- | src/Parser/Statement.hs | 13 | ||||
| -rw-r--r-- | src/Run.hs | 13 | ||||
| -rw-r--r-- | src/Test.hs | 1 |
3 files changed, 27 insertions, 0 deletions
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index e58779b..732f417 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -106,6 +106,13 @@ instance ParamType a => ParamType [a] where paramDefault _ = return [] paramFromSomeExpr _ se@(SomeExpr e) = cast e <|> ((:[]) <$> paramFromSomeExpr @a Proxy se) +instance ParamType a => ParamType (Maybe a) where + type ParamRep (Maybe a) = Maybe (ParamRep a) + parseParam _ = Just <$> parseParam @a Proxy + showParamType _ = showParamType @a Proxy + paramDefault _ = return Nothing + paramFromSomeExpr _ se = Just <$> paramFromSomeExpr @a Proxy se + instance (ParamType a, ParamType b) => ParamType (Either a b) where type ParamRep (Either a b) = Either (ParamRep a) (ParamRep b) parseParam _ = try (Left <$> parseParam @a Proxy) <|> (Right <$> parseParam @b Proxy) @@ -289,6 +296,11 @@ testExpect = command "expect" $ Expect <*> param "capture" <*> innerBlock +testFlush :: TestParser [TestStep] +testFlush = command "flush" $ Flush + <$> paramOrContext "from" + <*> param "" + testGuard :: TestParser [TestStep] testGuard = command "guard" $ Guard <$> cmdLine @@ -344,6 +356,7 @@ testStep = choice , testSpawn , testSend , testExpect + , testFlush , testGuard , testDisconnectNode , testDisconnectNodes @@ -10,6 +10,7 @@ import Control.Monad import Control.Monad.Except import Control.Monad.Reader +import Data.Either import Data.Map qualified as M import Data.Maybe import Data.Set qualified as S @@ -151,6 +152,10 @@ evalSteps = mapM_ $ \case p <- eval pname expect line p expr captures $ evalSteps inner + Flush pname expr -> do + p <- eval pname + flush p expr + Guard line expr -> do testStepGuard line expr @@ -304,6 +309,14 @@ expect (SourceLine sline) p expr tvars inner = do Nothing -> exprFailed (T.pack "expect") (SourceLine sline) (Just $ procName p) expr +flush :: Process -> Maybe (Expr Regex) -> TestRun () +flush p mbexpr = do + mbre <- sequence $ fmap eval mbexpr + atomicallyTest $ do + writeTVar (procOutput p) =<< case mbre of + Nothing -> return [] + Just re -> filter (isLeft . regexMatch re) <$> readTVar (procOutput p) + testStepGuard :: SourceLine -> Expr Bool -> TestRun () testStepGuard sline expr = do x <- eval expr diff --git a/src/Test.hs b/src/Test.hs index e336858..d080cae 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -42,6 +42,7 @@ data TestStep = forall a. ExprType a => Let SourceLine (TypedVarName a) (Expr a) | Spawn (TypedVarName Process) (Either (Expr Network) (Expr Node)) [TestStep] | Send (Expr Process) (Expr Text) | Expect SourceLine (Expr Process) (Expr Regex) [TypedVarName Text] [TestStep] + | Flush (Expr Process) (Maybe (Expr Regex)) | Guard SourceLine (Expr Bool) | DisconnectNode (Expr Node) [TestStep] | DisconnectNodes (Expr Network) [TestStep] |