From 89ed9a3a6c0ada2b1c252a5e24283b84eb0fa4c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Mon, 15 Sep 2025 21:10:39 +0200 Subject: =?UTF-8?q?Add=20timeout=20argument=20for=20the=20=E2=80=98expect?= =?UTF-8?q?=E2=80=99=20command?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Changelog: Added `timeout` argument for the `expect` command --- src/Run.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src/Run.hs') diff --git a/src/Run.hs b/src/Run.hs index 4a08742..1a1dea0 100644 --- a/src/Run.hs +++ b/src/Run.hs @@ -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) -- cgit v1.2.3