From: Luke Lau <luke_lau@icloud.com>
Date: Sat, 9 Jun 2018 22:15:23 +0000 (-0400)
Subject: Kill forked threads
X-Git-Tag: 0.1.0.0~76^2~2
X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=ac2553b38ed2228839cb72747f8c48b7c2fab488

Kill forked threads
---

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index f4fb5c1..fb928a4 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -132,10 +132,11 @@ runSessionWithHandler serverHandler rootDir session = do
   let context = SessionContext serverIn absRootDir messageChan reqMap
       initState = SessionState (IdInt 9)
 
-  forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut)
+  threadId <- forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut)
   (result, _) <- runSession' messageChan context initState session
 
   terminateProcess serverProc
+  killThread threadId
 
   return result
 
diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs
index 2b55382..2d5e4e6 100644
--- a/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@ -50,10 +50,14 @@ replaySession sessionDir = do
   rspSema <- newEmptyMVar
   passVar <- newEmptyMVar :: IO (MVar Bool)
 
-  forkIO $ runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar) sessionDir $
-    sendMessages clientMsgs reqSema rspSema
-
-  takeMVar passVar
+  threadId <- forkIO $
+    runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar)
+                          sessionDir
+                          (sendMessages clientMsgs reqSema rspSema)
+
+  result <- takeMVar passVar
+  killThread threadId
+  return result
 
   where
     isClientMsg (FromClient _ _) = True