From 03b823e44fc9b9153678d7d07cf905df4c767851 Mon Sep 17 00:00:00 2001
From: Curtis Chin Jen Sem <csochinjensem@gmail.com>
Date: Fri, 10 Apr 2026 14:26:54 +0200
Subject: [PATCH] Keep communication pipes alive for the entire test

---
 hls-test-utils/hls-test-utils.cabal |  1 +
 hls-test-utils/src/Test/Hls.hs      | 41 ++++++++++++++++++-----------
 2 files changed, 27 insertions(+), 15 deletions(-)

diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal
index cbe167ba1c..18aa56c740 100644
--- a/hls-test-utils/hls-test-utils.cabal
+++ b/hls-test-utils/hls-test-utils.cabal
@@ -50,6 +50,7 @@ library
     , lsp
     , lsp-test                ^>=0.18
     , lsp-types               ^>=2.4
+    , primitive
     , safe-exceptions
     , string-interpolate      >= 0.3.1
     , tasty
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 3c0180bef1..e1155f1205 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -82,6 +82,7 @@ import           Control.Lens.Extras                      (is)
 import           Control.Monad                            (guard, unless, void)
 import           Control.Monad.Extra                      (forM)
 import           Control.Monad.IO.Class
+import           Control.Monad.Primitive                  (keepAlive)
 import           Data.Aeson                               (Result (Success),
                                                            Value (Null),
                                                            fromJSON, toJSON)
@@ -830,8 +831,8 @@ wrapClientLogger logger = do
 runSessionWithTestConfig :: Pretty b => TestConfig b -> (FilePath -> Session a) -> IO a
 runSessionWithTestConfig TestConfig{..} session =
     runSessionInVFS testDirLocation $ \root -> shiftRoot root $ do
-    (inR, inW) <- createPipe
-    (outR, outW) <- createPipe
+    pipeIn@(inR, inW) <- createPipe
+    pipeOut@(outR, outW) <- createPipe
     let serverRoot = fromMaybe root testServerRoot
     let clientRoot = fromMaybe root testClientRoot
 
@@ -850,19 +851,29 @@ runSessionWithTestConfig TestConfig{..} session =
     timeoutOverride <- fmap read <$> lookupEnv "LSP_TIMEOUT"
     let sconf' = testConfigSession { lspConfig = hlsConfigToClientConfig testLspConfig, messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride}
         arguments = testingArgs serverRoot recorderIde plugins
-    server <- async $
-        IDEMain.defaultMain (cmapWithPrio LogIDEMain recorderIde)
-            arguments { argsHandleIn = pure inR , argsHandleOut = pure outW }
-    result <- runSessionWithHandles inW outR sconf' testConfigCaps clientRoot (session root)
-    hClose inW
-    timeout 3 (wait server) >>= \case
-        Just () -> pure ()
-        Nothing -> do
-            logWith testRecorder Info (TestServerExitTimeoutSeconds 3)
-            (t, _) <- duration $ cancel server
-            logWith testRecorder Info (TestServerCancelFinished (showDuration t))
-    logWith testRecorder Info TestRunFinished
-    pure result
+
+    -- Make an explicit call to keepAlive to protect both pipes from being GC'd.
+    --
+    -- If not done, a race condition forms from the handles of either pipe
+    -- being closed during the LSP shutdown process. For example, consider
+    -- lsp-test initiates the shutdown process, whereafter ghcide shuts down.
+    -- If it's write handle is closed due to GC, lsp-test, which has been
+    -- asynchronously reading from that handle's read end, will encounter a EOF
+    -- and crash.
+    keepAlive (pipeIn, pipeOut) $ do
+      server <- async $
+          IDEMain.defaultMain (cmapWithPrio LogIDEMain recorderIde)
+              arguments { argsHandleIn = pure inR , argsHandleOut = pure outW }
+      result <- runSessionWithHandles inW outR sconf' testConfigCaps clientRoot (session root)
+      hClose inW
+      timeout 3 (wait server) >>= \case
+          Just () -> pure ()
+          Nothing -> do
+              logWith testRecorder Info (TestServerExitTimeoutSeconds 3)
+              (t, _) <- duration $ cancel server
+              logWith testRecorder Info (TestServerCancelFinished (showDuration t))
+      logWith testRecorder Info TestRunFinished
+      pure result
 
     where
         shiftRoot shiftTarget f  =