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 |