diff options
-rw-r--r-- | src/Main.hs | 10 | ||||
-rw-r--r-- | src/Parser.hs | 8 | ||||
-rw-r--r-- | src/Test.hs | 2 |
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 |