@@ -65,7 +65,7 @@ import Control.Concurrent.Async (async, cancel, wait)
65
65
import Control.Concurrent.Extra
66
66
import Control.Exception.Base
67
67
import Control.Lens.Extras (is )
68
- import Control.Monad (guard , unless , void )
68
+ import Control.Monad (guard , unless , void , when )
69
69
import Control.Monad.Extra (forM )
70
70
import Control.Monad.IO.Class
71
71
import Data.Aeson (Result (Success ),
@@ -106,11 +106,14 @@ import Language.LSP.Protocol.Message
106
106
import Language.LSP.Protocol.Types hiding (Null )
107
107
import Language.LSP.Test
108
108
import Prelude hiding (log )
109
- import System.Directory (getCurrentDirectory ,
109
+ import System.Directory (createDirectory ,
110
+ doesDirectoryExist ,
111
+ getCurrentDirectory ,
112
+ getTemporaryDirectory ,
110
113
setCurrentDirectory )
111
- import System.Environment (lookupEnv )
114
+ import System.Environment (lookupEnv , setEnv )
112
115
import System.FilePath
113
- import System.IO.Extra (newTempDir , withTempDir )
116
+ import System.IO.Extra (newTempDirWithin )
114
117
import System.IO.Unsafe (unsafePerformIO )
115
118
import System.Process.Extra (createPipe )
116
119
import System.Time.Extra
@@ -423,22 +426,24 @@ runSessionWithServerInTmpDir' ::
423
426
Session a ->
424
427
IO a
425
428
runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
429
+ testRoot <- setupTestEnvironment
426
430
(recorder, _) <- initialiseTestRecorder
427
431
[" LSP_TEST_LOG_STDERR" , " HLS_TEST_HARNESS_STDERR" , " HLS_TEST_LOG_STDERR" ]
428
432
429
433
-- Do not clean up the temporary directory if this variable is set to anything but '0'.
430
434
-- Aids debugging.
431
435
cleanupTempDir <- lookupEnv " HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
432
- let runTestInDir = case cleanupTempDir of
436
+ let runTestInDir action = case cleanupTempDir of
433
437
Just val
434
- | val /= " 0" -> \ action -> do
435
- (tempDir, _) <- newTempDir
438
+ | val /= " 0" -> do
439
+ (tempDir, _) <- newTempDirWithin testRoot
436
440
a <- action tempDir
437
441
logWith recorder Debug LogNoCleanup
438
442
pure a
439
443
440
- _ -> \ action -> do
441
- a <- withTempDir action
444
+ _ -> do
445
+ (tempDir, cleanup) <- newTempDirWithin testRoot
446
+ a <- action tempDir `finally` cleanup
442
447
logWith recorder Debug LogCleanup
443
448
pure a
444
449
@@ -447,6 +452,32 @@ runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock loc
447
452
_fs <- FS. materialiseVFT tmpDir tree
448
453
runSessionWithServer' plugins conf sessConf caps tmpDir act
449
454
455
+ -- | Setup the test environment for isolated tests.
456
+ --
457
+ -- This creates a directory in the temporary directory that will be
458
+ -- reused for running isolated tests.
459
+ -- It returns the root to the testing directory that tests should use.
460
+ -- This directory is not fully cleaned between reruns.
461
+ -- However, it is totally safe to delete the directory between runs.
462
+ --
463
+ -- Additionally, this overwrites the 'XDG_CACHE_HOME' variable to isolate
464
+ -- the tests from existing caches. 'hie-bios' and 'ghcide' honour the
465
+ -- 'XDG_CACHE_HOME' environment variable and generate their caches there.
466
+ setupTestEnvironment :: IO FilePath
467
+ setupTestEnvironment = do
468
+ tmpDirRoot <- getTemporaryDirectory
469
+ let testRoot = tmpDirRoot </> " hls-test-root"
470
+ testCacheDir = testRoot </> " .cache"
471
+ createDirectoryIfMissing testRoot
472
+ createDirectoryIfMissing testCacheDir
473
+ setEnv " XDG_CACHE_HOME" testCacheDir
474
+ pure testRoot
475
+ where
476
+ createDirectoryIfMissing fp = do
477
+ exists <- doesDirectoryExist fp
478
+ when (not exists) $ do
479
+ createDirectory fp
480
+
450
481
goldenWithHaskellDocFormatter
451
482
:: Pretty b
452
483
=> Config
0 commit comments