summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-08-20 14:51:42 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2022-08-20 15:02:07 +0200
commitf40765688cc5c383cbf07550b06e7843e3acfe45 (patch)
tree06f07064127f423e1a94838a1176c9eb45d5d112 /src
parentff46d84b08fed346156c1b67478d4090a0b83f7d (diff)
Print relevant variables for guard failure
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs21
1 files changed, 11 insertions, 10 deletions
diff --git a/src/Main.hs b/src/Main.hs
index bb5ec02..29c45bc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -267,6 +267,14 @@ tryMatch re (x:xs) | Right (Just (_, _, _, capture)) <- regexec re x = Just ((x,
| otherwise = fmap (x:) <$> tryMatch re xs
tryMatch _ [] = Nothing
+exprFailed :: Text -> SourceLine -> Maybe ProcName -> Expr a -> TestRun ()
+exprFailed desc (SourceLine sline) pname expr = do
+ exprVars <- gatherVars expr
+ outLine OutputMatchFail pname $ T.concat [desc, T.pack " failed on ", sline]
+ forM_ exprVars $ \(name, value) ->
+ outLine OutputMatchFail pname $ T.concat [T.pack " ", textVarName name, T.pack " = ", textSomeVarValue value]
+ throwError ()
+
expect :: SourceLine -> Process -> Expr Regex -> [VarName] -> TestRun ()
expect (SourceLine sline) p expr vars = do
re <- eval expr
@@ -293,19 +301,12 @@ expect (SourceLine sline) p expr vars = do
modify $ \s -> s { tsVars = zip vars (map SomeVarValue capture) ++ tsVars s }
outLine OutputMatch (Just $ procName p) line
- Nothing -> do
- outLine OutputMatchFail (Just $ procName p) $ T.pack "expect failed on " `T.append` sline
- exprVars <- gatherVars expr
- forM_ exprVars $ \(name, value) ->
- outLine OutputMatchFail (Just $ procName p) $ T.concat [T.pack " ", textVarName name, T.pack " = ", textSomeVarValue value]
- throwError ()
+ Nothing -> exprFailed (T.pack "expect") (SourceLine sline) (Just $ procName p) expr
testStepGuard :: SourceLine -> Expr Bool -> TestRun ()
-testStepGuard (SourceLine sline) expr = do
+testStepGuard sline expr = do
x <- eval expr
- when (not x) $ do
- outLine OutputMatchFail Nothing $ T.pack "guard failed on " `T.append` sline
- throwError ()
+ when (not x) $ exprFailed (T.pack "guard") sline Nothing expr
allM :: Monad m => [a] -> (a -> m Bool) -> m Bool
allM (x:xs) p = p x >>= \case True -> allM xs p; False -> return False