diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-01-06 22:29:07 +0100 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-01-07 22:39:03 +0100 |
| commit | 401b4c233d12763853877d4c31a2cf4342ca87b6 (patch) | |
| tree | f6316d50ff413c73776f9d6c697deaef369cb1db /src/Parser | |
| parent | 0c21217fa599a7496a17d22c5105ef584785c350 (diff) | |
Call stack for the ‘expect’ statement
Diffstat (limited to 'src/Parser')
| -rw-r--r-- | src/Parser/Statement.hs | 13 |
1 files changed, 12 insertions, 1 deletions
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 9b02770..0e6314b 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -169,6 +169,12 @@ instance ParamType SourceLine where parseParam _ = mzero showParamType _ = "<source line>" +instance ParamType CallStack where + type ParamRep CallStack = Expr CallStack + parseParam _ = mzero + showParamType _ = "<call stack>" + paramExpr = id + instance ExprType a => ParamType (TypedVarName a) where parseParam _ = newVarName showParamType _ = "<variable>" @@ -269,6 +275,9 @@ paramOrContext name = fromParamOrContext <$> param name cmdLine :: CommandDef SourceLine cmdLine = param "" +callStack :: CommandDef CallStack +callStack = param "" + newtype InnerBlock a = InnerBlock { fromInnerBlock :: [ a ] -> TestBlock () } instance ExprType a => ParamType (InnerBlock a) where @@ -320,6 +329,7 @@ command name (CommandDef types ctor) = do iparams <- forM params $ \case (_, SomeParam (p :: Proxy p) Nothing) | Just (Refl :: p :~: SourceLine) <- eqT -> return $ SomeParam p $ Identity line + | Just (Refl :: p :~: CallStack) <- eqT -> return $ SomeParam p $ Identity $ Variable line callStackFqVarName | SomeNewVariables (vars :: [ TypedVarName a ]) <- definedVariables , Just (Refl :: p :~: InnerBlock a) <- eqT @@ -424,7 +434,8 @@ testSpawn = command "spawn" $ Spawn testExpect :: TestParser (Expr (TestBlock ())) testExpect = command "expect" $ Expect - <$> cmdLine + <$> callStack + <*> cmdLine <*> (fromExprParam <$> paramOrContext "from") <*> param "" <*> (maybe 1 fromExprParam <$> param "timeout") |