From 1c811959187626f33d9b6c9f04f5768155388876 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 22 Jun 2021 15:41:59 +0800 Subject: [iserv] learn -wait cli flag Often times when attaching a debugger to iserv it's helpful to have iserv wait a few seconds for the debugger to attach. -wait can be passed via -opti-wait if needed. --- utils/iserv/src/Main.hs | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) (limited to 'utils') diff --git a/utils/iserv/src/Main.hs b/utils/iserv/src/Main.hs index 6915552f91..d213fa9e4d 100644 --- a/utils/iserv/src/Main.hs +++ b/utils/iserv/src/Main.hs @@ -15,6 +15,7 @@ import GHCi.Signals import GHCi.Utils import Control.Exception +import Control.Concurrent (threadDelay) import Control.Monad import Data.IORef import System.Environment @@ -43,10 +44,17 @@ main = do return (wfd1, rfd2, rest) _ -> dieWithUsage - verbose <- case rest of - ["-v"] -> return True - [] -> return False - _ -> dieWithUsage + (verbose, rest') <- case rest of + "-v":rest' -> return (True, rest') + _ -> return (False, rest) + + (wait, rest'') <- case rest' of + "-wait":rest'' -> return (True, rest'') + _ -> return (False, rest') + + unless (null rest'') $ + dieWithUsage + when verbose $ printf "GHC iserv starting (in: %d; out: %d)\n" (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) @@ -55,9 +63,14 @@ main = do installSignalHandlers lo_ref <- newIORef Nothing let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref} + + when wait $ do + when verbose $ + putStrLn "Waiting 3s" + threadDelay 3000000 + uninterruptibleMask $ serv verbose hook pipe where hook = return -- empty hook -- we cannot allow any async exceptions while communicating, because -- we will lose sync in the protocol, hence uninterruptibleMask. - -- cgit v1.2.1