From b309d85499175ef3b8dbbc71f7fd57a5d0660f88 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 18 Jan 2022 21:37:56 +0100
Subject: Default timeout command-line parameter

---
 erebos-tester.cabal |  1 +
 src/Main.hs         | 17 +++++++++++++----
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index 770b71d..4842cc3 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -57,6 +57,7 @@ executable erebos-tester-core
                        mtl ^>=2.2.2,
                        process ^>=1.6.9,
                        regex-tdfa ^>=1.3.1.0,
+                       scientific       >=0.3 && < 0.4,
                        stm ^>=2.5.0.1,
                        text ^>=1.2.4.0,
                        unix ^>=2.7.2.2,
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"
-- 
cgit v1.2.3