summaryrefslogtreecommitdiff
path: root/src/Run.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2026-01-06 22:29:07 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2026-01-07 22:39:03 +0100
commit401b4c233d12763853877d4c31a2cf4342ca87b6 (patch)
treef6316d50ff413c73776f9d6c697deaef369cb1db /src/Run.hs
parent0c21217fa599a7496a17d22c5105ef584785c350 (diff)
Call stack for the ‘expect’ statement
Diffstat (limited to 'src/Run.hs')
-rw-r--r--src/Run.hs15
1 files changed, 8 insertions, 7 deletions
diff --git a/src/Run.hs b/src/Run.hs
index 436ce6b..45eec46 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -79,7 +79,7 @@ runTest out opts gdefs test = do
}
tstate = TestState
{ tsGlobals = gdefs
- , tsLocals = []
+ , tsLocals = [ ( callStackVarName, someConstValue (CallStack []) ) ]
, tsNodePacketLoss = M.empty
, tsDisconnectedUp = S.empty
, tsDisconnectedBridge = S.empty
@@ -203,8 +203,8 @@ runStep = \case
outProc OutputChildStdin p line
send p line
- Expect line p expr timeout captures inner -> do
- expect line p expr timeout captures $ runStep . inner
+ Expect stack line p expr timeout captures inner -> do
+ expect stack line p expr timeout captures $ runStep . inner
Flush p regex -> do
atomicallyTest $ flushProcessOutput p regex
@@ -319,8 +319,9 @@ exprFailed desc stack pname = do
outLine (OutputMatchFail stack) (Just prompt) $ desc <> " failed"
throwError Failed
-expect :: SourceLine -> Process -> Traced Regex -> Scientific -> [TypedVarName Text] -> ([ Text ] -> TestRun ()) -> TestRun ()
-expect sline p (Traced trace re) etimeout tvars inner = do
+expect :: CallStack -> SourceLine -> Process -> Traced Regex -> Scientific -> [ TypedVarName Text ] -> ([ Text ] -> TestRun ()) -> TestRun ()
+expect (CallStack cs) sline p (Traced trace re) etimeout tvars inner = do
+ let stack = CallStack (( sline, trace ) : cs)
timeout <- (etimeout *) <$> getCurrentTimeout
delay <- liftIO $ registerDelay $ ceiling $ 1000000 * timeout
mbmatch <- atomicallyTest $ (Nothing <$ (check =<< readTVar delay)) <|> do
@@ -335,13 +336,13 @@ expect sline p (Traced trace re) etimeout tvars inner = do
let vars = map (\(TypedVarName n) -> n) tvars
when (length vars /= length capture) $ do
- outProc (OutputMatchFail (CallStack [ ( sline, [] ) ])) p $ T.pack "mismatched number of capture variables on " `T.append` textSourceLine sline
+ outProc (OutputMatchFail stack) p $ T.pack "mismatched number of capture variables"
throwError Failed
outProc OutputMatch p line
inner capture
- Nothing -> exprFailed (T.pack "expect") (CallStack [ ( sline, trace ) ]) (Just $ procName p)
+ Nothing -> exprFailed (T.pack "expect") stack (Just $ procName p)
testStepGuard :: CallStack -> Bool -> TestRun ()
testStepGuard stack x = do