Show regex partern on expect failure

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