6363import Control.Applicative.Combinators
6464import Control.Concurrent.Async (async , cancel , wait )
6565import Control.Concurrent.Extra
66- import Control.Exception.Base
66+ import Control.Exception.Safe
6767import Control.Lens.Extras (is )
68- import Control.Monad (guard , unless , void )
68+ import Control.Monad (guard , unless , void , when )
6969import Control.Monad.Extra (forM )
7070import Control.Monad.IO.Class
7171import Data.Aeson (Result (Success ),
@@ -106,11 +106,13 @@ import Language.LSP.Protocol.Message
106106import Language.LSP.Protocol.Types hiding (Null )
107107import Language.LSP.Test
108108import Prelude hiding (log )
109- import System.Directory (getCurrentDirectory ,
109+ import System.Directory (createDirectoryIfMissing ,
110+ getCurrentDirectory ,
111+ getTemporaryDirectory ,
110112 setCurrentDirectory )
111- import System.Environment (lookupEnv )
113+ import System.Environment (lookupEnv , setEnv )
112114import System.FilePath
113- import System.IO.Extra (newTempDir , withTempDir )
115+ import System.IO.Extra (newTempDirWithin )
114116import System.IO.Unsafe (unsafePerformIO )
115117import System.Process.Extra (createPipe )
116118import System.Time.Extra
@@ -423,22 +425,24 @@ runSessionWithServerInTmpDir' ::
423425 Session a ->
424426 IO a
425427runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
428+ testRoot <- setupTestEnvironment
426429 (recorder, _) <- initialiseTestRecorder
427430 [" LSP_TEST_LOG_STDERR" , " HLS_TEST_HARNESS_STDERR" , " HLS_TEST_LOG_STDERR" ]
428431
429432 -- Do not clean up the temporary directory if this variable is set to anything but '0'.
430433 -- Aids debugging.
431434 cleanupTempDir <- lookupEnv " HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
432- let runTestInDir = case cleanupTempDir of
435+ let runTestInDir action = case cleanupTempDir of
433436 Just val
434- | val /= " 0" -> \ action -> do
435- (tempDir, _) <- newTempDir
437+ | val /= " 0" -> do
438+ (tempDir, _) <- newTempDirWithin testRoot
436439 a <- action tempDir
437440 logWith recorder Debug LogNoCleanup
438441 pure a
439442
440- _ -> \ action -> do
441- a <- withTempDir action
443+ _ -> do
444+ (tempDir, cleanup) <- newTempDirWithin testRoot
445+ a <- action tempDir `finally` cleanup
442446 logWith recorder Debug LogCleanup
443447 pure a
444448
@@ -447,6 +451,25 @@ runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock loc
447451 _fs <- FS. materialiseVFT tmpDir tree
448452 runSessionWithServer' plugins conf sessConf caps tmpDir act
449453
454+ -- | Setup the test environment for isolated tests.
455+ --
456+ -- This creates a directory in the temporary directory that will be
457+ -- reused for running isolated tests.
458+ -- It returns the root to the testing directory that tests should use.
459+ -- This directory is not fully cleaned between reruns.
460+ -- However, it is totally safe to delete the directory between runs.
461+ --
462+ -- Additionally, this overwrites the 'XDG_CACHE_HOME' variable to isolate
463+ -- the tests from existing caches. 'hie-bios' and 'ghcide' honour the
464+ -- 'XDG_CACHE_HOME' environment variable and generate their caches there.
465+ setupTestEnvironment :: IO FilePath
466+ setupTestEnvironment = do
467+ tmpDirRoot <- getTemporaryDirectory
468+ let testRoot = tmpDirRoot </> " hls-test-root"
469+ testCacheDir = testRoot </> " .cache"
470+ createDirectoryIfMissing True testCacheDir
471+ setEnv " XDG_CACHE_HOME" testCacheDir
472+ pure testRoot
450473goldenWithHaskellDocFormatter
451474 :: Pretty b
452475 => Config
0 commit comments