summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2021-11-18 21:27:22 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2021-11-18 21:27:22 +0100
commite30d876d4839ab70f655adf893e85b1b1312192c (patch)
treee1d6e3a3b9beafa899251541d27a185d891fc6ee
parent19dd575ae33801121b308c082bab70c3bed0a24e (diff)
Show regex partern on expect failure
-rw-r--r--src/Main.hs10
-rw-r--r--src/Parser.hs8
-rw-r--r--src/Test.hs2
3 files changed, 10 insertions, 10 deletions
diff --git a/src/Main.hs b/src/Main.hs
index fd62a3e..ca4ff8c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -164,8 +164,8 @@ tryMatch re (x:xs) | Right (Just _) <- regexec re x = Just (x, xs)
| otherwise = fmap (x:) <$> tryMatch re xs
tryMatch _ [] = Nothing
-expect :: Output -> Process -> Regex -> IO Bool
-expect out p re = do
+expect :: Output -> Process -> Regex -> Text -> IO Bool
+expect out p re pat = do
delay <- registerDelay 1000000
mbmatch <- atomically $ (Nothing <$ (check =<< readTVar delay)) <|> do
line <- readTVar (procOutput p)
@@ -179,7 +179,7 @@ expect out p re = do
outLine out OutputMatch (Just $ procName p) line
return True
Nothing -> do
- outLine out OutputMatchFail (Just $ procName p) $ T.pack "expect failed"
+ outLine out OutputMatchFail (Just $ procName p) $ T.pack "expect failed /" `T.append` pat `T.append` T.pack "/"
return False
send :: Process -> Text -> IO Bool
@@ -219,9 +219,9 @@ runTest out tool test = do
p <- getProcess net pname
send p line
- Expect pname regex -> do
+ Expect pname regex pat -> do
p <- getProcess net pname
- expect out p regex
+ expect out p regex pat
Wait -> do
outPrompt out $ T.pack "Waiting..."
diff --git a/src/Parser.hs b/src/Parser.hs
index 1402926..fb1b829 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -79,14 +79,14 @@ quotedString = label "string" $ lexeme $ do
symbol "\""
return $ TL.toStrict str
-regex :: TestParser Regex
+regex :: TestParser (Regex, Text)
regex = label "regular expression" $ lexeme $ do
symbol "/"
pat <- takeWhileP Nothing (/='/')
symbol "/"
case compile defaultCompOpt defaultExecOpt ("^" ++ TL.unpack pat ++ "$") of
Left err -> fail err
- Right re -> return re
+ Right re -> return (re, TL.toStrict pat)
testSpawn :: TestParser TestStep
testSpawn = do
@@ -108,10 +108,10 @@ testSend = do
testExpect :: TestParser TestStep
testExpect = do
wsymbol "expect"
- re <- regex
+ (re, pat) <- regex
wsymbol "from"
pname <- procName
- return $ Expect pname re
+ return $ Expect pname re pat
testWait :: TestParser TestStep
testWait = do
diff --git a/src/Test.hs b/src/Test.hs
index 83ffac5..4988098 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -18,7 +18,7 @@ data Test = Test
data TestStep = Spawn ProcName NodeName
| Send ProcName Text
- | Expect ProcName Regex
+ | Expect ProcName Regex Text
| Wait
newtype ProcName = ProcName Text