summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-10-23 21:05:55 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-10-23 21:05:55 +0200
commit224366e2c668784952ab613c7640d7017ce60990 (patch)
treeebbad4d9d53119c6f1b0f74ada973efa8ac06a86 /src
parentff5c3f5a91e249694f3b76109027cf9d0c717a7c (diff)
Flush command
Changelog: Add 'flush' command
Diffstat (limited to 'src')
-rw-r--r--src/Parser/Statement.hs13
-rw-r--r--src/Run.hs13
-rw-r--r--src/Test.hs1
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
diff --git a/src/Run.hs b/src/Run.hs
index 04fa9ee..a40641b 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -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]