diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-09-15 21:10:39 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-09-19 19:44:28 +0200 |
| commit | 89ed9a3a6c0ada2b1c252a5e24283b84eb0fa4c8 (patch) | |
| tree | 5ba8a271690d43bab73fd4c86ff2702ca8afce45 /src | |
| parent | 77fdc01b6dfa6f497ed80a46c51e227ca9bdaeed (diff) | |
Add timeout argument for the ‘expect’ command
Changelog: Added `timeout` argument for the `expect` command
Diffstat (limited to 'src')
| -rw-r--r-- | src/Parser/Statement.hs | 1 | ||||
| -rw-r--r-- | src/Run.hs | 10 | ||||
| -rw-r--r-- | src/Test.hs | 2 |
3 files changed, 7 insertions, 6 deletions
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 474fa03..571a38e 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -434,6 +434,7 @@ testExpect = command "expect" $ Expect <$> cmdLine <*> (fromExprParam <$> paramOrContext "from") <*> param "" + <*> (maybe 1 fromExprParam <$> param "timeout") <*> param "capture" <*> innerBlockFunList @@ -202,8 +202,8 @@ runStep = \case outProc OutputChildStdin p line send p line - Expect line p expr captures inner -> do - expect line p expr captures $ runStep . inner + Expect line p expr timeout captures inner -> do + expect line p expr timeout captures $ runStep . inner Flush p regex -> do atomicallyTest $ flushProcessOutput p regex @@ -318,9 +318,9 @@ exprFailed desc stack pname = do outLine (OutputMatchFail stack) (Just prompt) $ desc <> " failed" throwError Failed -expect :: SourceLine -> Process -> Traced Regex -> [TypedVarName Text] -> ([ Text ] -> TestRun ()) -> TestRun () -expect sline p (Traced trace re) tvars inner = do - timeout <- getCurrentTimeout +expect :: SourceLine -> Process -> Traced Regex -> Scientific -> [TypedVarName Text] -> ([ Text ] -> TestRun ()) -> TestRun () +expect sline p (Traced trace re) etimeout tvars inner = do + timeout <- (etimeout *) <$> getCurrentTimeout delay <- liftIO $ registerDelay $ ceiling $ 1000000 * timeout mbmatch <- atomicallyTest $ (Nothing <$ (check =<< readTVar delay)) <|> do line <- readTVar (procOutput p) diff --git a/src/Test.hs b/src/Test.hs index 18933b1..1481b2b 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -48,7 +48,7 @@ data TestStep a where Spawn :: TypedVarName Process -> Either Network Node -> [ Text ] -> (Process -> TestStep a) -> TestStep a SpawnShell :: Maybe (TypedVarName Process) -> Node -> ShellScript -> (Process -> TestStep a) -> TestStep a Send :: Process -> Text -> TestStep () - Expect :: SourceLine -> Process -> Traced Regex -> [ TypedVarName Text ] -> ([ Text ] -> TestStep a) -> TestStep a + Expect :: SourceLine -> Process -> Traced Regex -> Scientific -> [ TypedVarName Text ] -> ([ Text ] -> TestStep a) -> TestStep a Flush :: Process -> Maybe Regex -> TestStep () Guard :: CallStack -> Bool -> TestStep () DisconnectNode :: Node -> TestStep a -> TestStep a |