From 958c0a17842612f667cba89fe6712a2197985aad Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 13 Oct 2022 22:13:29 +0200
Subject: GDB process type and separate start function

---
 src/Main.hs | 23 +++++------------------
 1 file changed, 5 insertions(+), 18 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index 38c4099..0330733 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,7 +14,6 @@ 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 (readMaybe)
 
@@ -23,8 +22,6 @@ import System.Directory
 import System.Environment
 import System.Exit
 import System.FilePath
-import System.IO
-import System.IO.Error
 import System.Posix.Process
 import System.Posix.Signals
 import System.Process
@@ -61,7 +58,7 @@ data TestEnv = TestEnv
     { teOutput :: Output
     , teFailed :: TVar (Maybe Failed)
     , teOptions :: Options
-    , teGDB :: Maybe (MVar Process)
+    , teGDB :: Maybe (MVar GDB)
     }
 
 data TestState = TestState
@@ -153,8 +150,8 @@ initNetwork inner = do
     useGDB <- asks $ optGDB . teOptions . fst
     mgdb <- if useGDB
         then do
-            gdb <- spawnOn (Left net) ProcNameGDB Nothing gdbCmd
-            gdbInit gdb
+            gdb <- gdbStart
+            liftIO $ modifyMVar_ (netProcesses net) $ return . (gdbProcess gdb:)
             Just <$> liftIO (newMVar gdb)
         else return Nothing
 
@@ -226,20 +223,10 @@ spawnOn target pname killWith cmd = do
             , procNode = either (const undefined) id target
             }
 
-    let readingLoop :: Handle -> (Text -> TestRun ()) -> TestRun ()
-        readingLoop h act =
-            liftIO (tryIOError (T.hGetLine h)) >>= \case
-                Left err
-                    | isEOFError err -> return ()
-                    | otherwise -> outProc OutputChildFail process $ T.pack $ "IO error: " ++ show err
-                Right line -> do
-                    act line
-                    readingLoop h act
-
-    forkTest $ readingLoop hout $ \line -> do
+    forkTest $ lineReadingLoop process hout $ \line -> do
         outProc OutputChildStdout process line
         liftIO $ atomically $ modifyTVar pout (++[line])
-    forkTest $ readingLoop herr $ \line -> do
+    forkTest $ lineReadingLoop process herr $ \line -> do
         case pname of
              ProcNameTcpdump -> return ()
              _ -> outProc OutputChildStderr process line
-- 
cgit v1.2.3