summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs17
1 files changed, 13 insertions, 4 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 712d2b1..d671050 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,10 +7,12 @@ import Control.Monad
import Data.List
import Data.Maybe
+import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
+import Text.Read
import Text.Regex.TDFA
import Text.Regex.TDFA.Text
@@ -45,6 +47,7 @@ data Node = Node
data Options = Options
{ optDefaultTool :: String
, optProcTools :: [(ProcName, String)]
+ , optTimeout :: Scientific
, optGDB :: Bool
}
@@ -52,6 +55,7 @@ defaultOptions :: Options
defaultOptions = Options
{ optDefaultTool = ""
, optProcTools = []
+ , optTimeout = 1
, optGDB = False
}
@@ -208,9 +212,9 @@ tryMatch re (x:xs) | Right (Just _) <- regexec re x = Just (x, xs)
| otherwise = fmap (x:) <$> tryMatch re xs
tryMatch _ [] = Nothing
-expect :: Output -> Process -> Regex -> Text -> IO Bool
-expect out p re pat = do
- delay <- registerDelay 1000000
+expect :: Output -> Options -> Process -> Regex -> Text -> IO Bool
+expect out opts p re pat = do
+ delay <- registerDelay $ ceiling $ 1000000 * optTimeout opts
mbmatch <- atomically $ (Nothing <$ (check =<< readTVar delay)) <|> do
line <- readTVar (procOutput p)
case tryMatch re line of
@@ -266,7 +270,7 @@ runTest out opts test = do
Expect pname regex pat -> do
p <- getProcess net pname
- expect out p regex pat
+ expect out opts p regex pat
Wait -> do
outPrompt out $ T.pack "Waiting..."
@@ -286,6 +290,11 @@ options =
(pname, (_:path)) -> opts { optProcTools = (ProcName (T.pack pname), path) : optProcTools opts }
) "PATH")
"test tool to be used"
+ , Option ['t'] ["timeout"]
+ (ReqArg (\str opts -> case readMaybe str of
+ Just timeout -> opts { optTimeout = timeout }
+ Nothing -> error "timeout must be a number") "SECONDS")
+ "default timeout in seconds with microsecond precision"
, Option ['g'] ["gdb"]
(NoArg (\opts -> opts { optGDB = True }))
"run GDB and attach spawned pracesses"