From 000209c13299f1c046dc60e3649c17e9520680de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 13 Oct 2022 21:05:31 +0200 Subject: Fail test and start gdb session immediately on process crash --- src/GDB.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'src/GDB.hs') diff --git a/src/GDB.hs b/src/GDB.hs index 76c33c1..8e04c42 100644 --- a/src/GDB.hs +++ b/src/GDB.hs @@ -12,6 +12,7 @@ import Data.Text.IO qualified as T import System.IO.Error import System.Process +import Output import Process gdbCmd :: String @@ -29,10 +30,14 @@ addInferior gdb i pid = do send gdb $ T.pack $ "-target-attach --thread-group i" ++ show i ++ " " ++ show pid send gdb $ T.pack $ "-exec-continue --thread-group i" ++ show i -gdbSession :: MonadIO m => Process -> m () -gdbSession gdb = liftIO $ do - catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) >>= \case +gdbSession :: MonadOutput m => Process -> m () +gdbSession gdb = do + outPrompt $ T.pack "gdb> " + liftIO loop + outClearPrompt + where + loop = catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) >>= \case Just line -> do send gdb (T.pack "-interpreter-exec console \"" `T.append` line `T.append` T.pack "\"") - gdbSession gdb + loop Nothing -> return () -- cgit v1.2.3