Set the XDG_CACHE_HOME for tests

.github/workflows/test.yml

@@ -48,8 +48,7 @@ jobs:
         uses: fkirc/[email protected]
         with:
           cancel_others: false
-          paths_ignore: '[ "hls-test-utils/**"
-                         , "plugins/**"
+          paths_ignore: '[ "plugins/**"
                          , "src/**"
                          , "exe/**"
                          , "test/**"

ghcide-test/exe/BootTests.hs

@@ -27,25 +27,24 @@ tests = testGroup "boot"
         let cPath = dir </> "C.hs"
         cSource <- liftIO $ readFileUtf8 cPath
         -- Dirty the cache
-        liftIO $ runInDir dir $ do
-            cDoc <- createDoc cPath "haskell" cSource
-            -- We send a hover request then wait for either the hover response or
-            -- `ghcide/reference/ready` notification.
-            -- Once we receive one of the above, we wait for the other that we
-            -- haven't received yet.
-            -- If we don't wait for the `ready` notification it is possible
-            -- that the `getDefinitions` request/response in the outer ghcide
-            -- session will find no definitions.
-            let hoverParams = HoverParams cDoc (Position 4 3) Nothing
-            hoverRequestId <- sendRequest SMethod_TextDocumentHover hoverParams
-            let parseReadyMessage = isReferenceReady cPath
-            let parseHoverResponse = responseForId SMethod_TextDocumentHover hoverRequestId
-            hoverResponseOrReadyMessage <- skipManyTill anyMessage ((Left <$> parseHoverResponse) <|> (Right <$> parseReadyMessage))
-            _ <- skipManyTill anyMessage $
-              case hoverResponseOrReadyMessage of
-                Left _  -> void parseReadyMessage
-                Right _ -> void parseHoverResponse
-            closeDoc cDoc
+        cDoc <- createDoc cPath "haskell" cSource
+        -- We send a hover request then wait for either the hover response or
+        -- `ghcide/reference/ready` notification.
+        -- Once we receive one of the above, we wait for the other that we
+        -- haven't received yet.
+        -- If we don't wait for the `ready` notification it is possible
+        -- that the `getDefinitions` request/response in the outer ghcide
+        -- session will find no definitions.
+        let hoverParams = HoverParams cDoc (Position 4 3) Nothing
+        hoverRequestId <- sendRequest SMethod_TextDocumentHover hoverParams
+        let parseReadyMessage = isReferenceReady cPath
+        let parseHoverResponse = responseForId SMethod_TextDocumentHover hoverRequestId
+        hoverResponseOrReadyMessage <- skipManyTill anyMessage ((Left <$> parseHoverResponse) <|> (Right <$> parseReadyMessage))
+        _ <- skipManyTill anyMessage $
+            case hoverResponseOrReadyMessage of
+            Left _  -> void parseReadyMessage
+            Right _ -> void parseHoverResponse
+        closeDoc cDoc
         cdoc <- createDoc cPath "haskell" cSource
         locs <- getDefinitions cdoc (Position 7 4)
         let floc = mkR 9 0 9 1

ghcide-test/exe/CradleTests.hs

@@ -3,7 +3,7 @@
 
 module CradleTests (tests) where
 
-import           Config                          (checkDefs, mkL, runInDir,
+import           Config                          (checkDefs, mkL,
                                                   runWithExtraFiles,
                                                   testWithDummyPluginEmpty')
 import           Control.Applicative.Combinators
@@ -175,12 +175,9 @@ simpleMultiDefTest variant = ignoreForWindows $ testCase testName $
     runWithExtraFiles variant $ \dir -> do
     let aPath = dir </> "a/A.hs"
         bPath = dir </> "b/B.hs"
-    adoc <- liftIO $ runInDir dir $ do
-      aSource <- liftIO $ readFileUtf8 aPath
-      adoc <- createDoc aPath "haskell" aSource
-      skipManyTill anyMessage $ isReferenceReady aPath
-      closeDoc adoc
-      pure adoc
+    adoc <- openDoc aPath "haskell"
+    skipManyTill anyMessage $ isReferenceReady aPath
+    closeDoc adoc
     bSource <- liftIO $ readFileUtf8 bPath
     bdoc <- createDoc bPath "haskell" bSource
     locs <- getDefinitions bdoc (Position 2 7)

ghcide-test/exe/FindDefinitionAndHoverTests.hs

@@ -187,7 +187,7 @@ tests = let
   holeL65 = Position 65 8  ;  hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]]
   cccL17 = Position 17 16  ;  docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"]
   imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
-  reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], if ghcVersion < GHC910 then mkL bar 3 5 3 8 else mkL bar 3 0 3 14]
+  reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14]
   thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]
   cmtL68 = Position 67  0  ;  lackOfdEq = [ExpectHoverExcludeText ["$dEq"]]
   import310 = Position 3 10; pkgTxt = [ExpectHoverText ["Data.Text\n\ntext-"]]

ghcide/src/Development/IDE/Core/Compile.hs

@@ -70,7 +70,7 @@
 import           Data.Time                                    (UTCTime (..))
 import           Data.Tuple.Extra                             (dupe)
 import           Debug.Trace
 import           Development.IDE.Core.FileStore               (resetInterfaceStore)
 import           Development.IDE.Core.Preprocessor
 import           Development.IDE.Core.ProgressReporting       (progressUpdate)
 import           Development.IDE.Core.RuleTypes
@@ -823,7 +823,7 @@
         tcs = tcg_tcs ts :: [TyCon]
         hie_asts = GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs
 
     pure $ Just $
 #if MIN_VERSION_ghc(9,11,0)
       hie_asts (tcg_type_env ts)
 #else
@@ -1103,7 +1103,7 @@
 
 
         convImport (L _ i) = (
                                (ideclPkgQual i)
                              , reLoc $ ideclName i)
 
         msrImports = implicit_imports ++ imps
@@ -1120,11 +1120,7 @@
     liftIO $ evaluate $ rnf textualImports
 
 
-    modLoc <- liftIO $ if mod == mAIN_NAME
-        -- specially in tests it's common to have lots of nameless modules
-        -- mkHomeModLocation will map them to the same hi/hie locations
-        then mkHomeModLocation dflags (pathToModuleName fp) fp
-        else mkHomeModLocation dflags mod fp
+    modLoc <- liftIO $ mkHomeModLocation dflags mod fp
 
     let modl = mkHomeModule (hscHomeUnit ppEnv) mod
         sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile

hls-test-utils/src/Test/Hls.hs

@@ -507,32 +507,73 @@ runSessionWithServerInTmpDir config plugin tree act =
     {testLspConfig=config, testPluginDescriptor = plugin,  testDirLocation=Right tree}
     (const act)
 
-runWithLockInTempDir :: VirtualFileTree -> (FileSystem -> IO a) ->  IO a
-runWithLockInTempDir tree act = withLock lockForTempDirs $ do
+-- | Same as 'withTemporaryDataAndCacheDirectory', but materialises the given
+-- 'VirtualFileTree' in the temporary directory.
+withVfsTestDataDirectory :: VirtualFileTree -> (FileSystem -> IO a) ->  IO a
+withVfsTestDataDirectory tree act = do
+    withTemporaryDataAndCacheDirectory $ \tmpRoot -> do
+        fs <- FS.materialiseVFT tmpRoot tree
+        act fs
+
+-- | Run an action in a temporary directory.
+-- Sets the 'XDG_CACHE_HOME' environment variable to a temporary directory as well.
+--
+-- This sets up a temporary directory for HLS tests to run.
+-- Typically, HLS tests copy their test data into the directory and then launch
+-- the HLS session in that directory.
+-- This makes sure that the tests are run in isolation, which is good for correctness
+-- but also important to have fast tests.
+--
+-- For improved isolation, we also make sure the 'XDG_CACHE_HOME' environment
+-- variable points to a temporary directory. So, we never share interface files
+-- or the 'hiedb' across tests.
+withTemporaryDataAndCacheDirectory :: (FilePath -> IO a) -> IO a
+withTemporaryDataAndCacheDirectory act = withLock lockForTempDirs $ do
     testRoot <- setupTestEnvironment
     helperRecorder <- hlsHelperTestRecorder
     -- Do not clean up the temporary directory if this variable is set to anything but '0'.
     -- Aids debugging.
     cleanupTempDir <- lookupEnv "HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
     let runTestInDir action = case cleanupTempDir of
             Just val | val /= "0" -> do
-                (tempDir, _) <- newTempDirWithin testRoot
-                a <- action tempDir
+                (tempDir, cacheHome, _) <- setupTemporaryTestDirectories testRoot
+                a <- withTempCacheHome cacheHome (action tempDir)
                 logWith helperRecorder Debug LogNoCleanup
                 pure a
 
             _ -> do
-                (tempDir, cleanup) <- newTempDirWithin testRoot
-                a <- action tempDir `finally` cleanup
+                (tempDir, cacheHome, cleanup) <- setupTemporaryTestDirectories testRoot
+                a <- withTempCacheHome cacheHome (action tempDir) `finally`  cleanup
                 logWith helperRecorder Debug LogCleanup
                 pure a
     runTestInDir $ \tmpDir' -> do
         -- we canonicalize the path, so that we do not need to do
-        -- cannibalization during the test when we compare two paths
+        -- canonicalization during the test when we compare two paths
         tmpDir <- canonicalizePath tmpDir'
         logWith helperRecorder Info $ LogTestDir tmpDir
-        fs <- FS.materialiseVFT tmpDir tree
-        act fs
+        act tmpDir
+    where
+        cache_home_var = "XDG_CACHE_HOME"
+        -- Set the dir for "XDG_CACHE_HOME".
+        -- When the operation finished, make sure the old value is restored.
+        withTempCacheHome tempCacheHomeDir act =
+            bracket
+              (do
+                old_cache_home <- lookupEnv cache_home_var
+                setEnv cache_home_var tempCacheHomeDir
+                pure old_cache_home)
+              (\old_cache_home ->
+                maybe (pure ()) (setEnv cache_home_var) old_cache_home
+                )
+              (\_ -> act)
+
+        -- Set up a temporary directory for the test files and one for the 'XDG_CACHE_HOME'.
+        -- The 'XDG_CACHE_HOME' is important for independent test runs, i.e. completely empty
+        -- caches.
+        setupTemporaryTestDirectories testRoot = do
+            (tempTestCaseDir, cleanup1) <- newTempDirWithin testRoot
+            (tempCacheHomeDir, cleanup2) <- newTempDirWithin testRoot
+            pure (tempTestCaseDir, tempCacheHomeDir, cleanup1 >> cleanup2)
 
 runSessionWithServer :: Pretty b => Config -> PluginTestDescriptor b -> FilePath -> Session a -> IO a
 runSessionWithServer config plugin fp act =
@@ -565,17 +606,11 @@ instance Default (TestConfig b) where
 -- It returns the root to the testing directory that tests should use.
 -- This directory is not fully cleaned between reruns.
 -- However, it is totally safe to delete the directory between runs.
---
--- Additionally, this overwrites the 'XDG_CACHE_HOME' variable to isolate
--- the tests from existing caches. 'hie-bios' and 'ghcide' honour the
--- 'XDG_CACHE_HOME' environment variable and generate their caches there.
 setupTestEnvironment :: IO FilePath
 setupTestEnvironment = do
   tmpDirRoot <- getTemporaryDirectory
-  let testRoot = tmpDirRoot </> "hls-test-root"
-      testCacheDir = testRoot </> ".cache"
-  createDirectoryIfMissing True testCacheDir
-  setEnv "XDG_CACHE_HOME" testCacheDir
+  let testRoot = tmpDirRoot </> "hls-tests"
+  createDirectoryIfMissing True testRoot
   pure testRoot
 
 goldenWithHaskellDocFormatter
@@ -692,7 +727,6 @@ lockForTempDirs = unsafePerformIO newLock
 data TestConfig b = TestConfig
   {
     testDirLocation          :: Either FilePath VirtualFileTree
-    -- ^ Client capabilities
     -- ^ The file tree to use for the test, either a directory or a virtual file tree
     -- if using a virtual file tree,
     -- Creates a temporary directory, and materializes the VirtualFileTree
@@ -747,8 +781,20 @@ wrapClientLogger logger = do
     return (lspLogRecorder <> logger, cb1)
 
 -- | Host a server, and run a test session on it.
--- For setting custom timeout, set the environment variable 'LSP_TIMEOUT'
--- * LSP_TIMEOUT=10 cabal test
+--
+-- Environment variables are used to influence logging verbosity, test cleanup and test execution:
+--
+-- * @LSP_TIMEOUT@: Set a specific test timeout in seconds.
+-- * @LSP_TEST_LOG_MESSAGES@: Log the LSP messages between the client and server.
+-- * @LSP_TEST_LOG_STDERR@: Log the stderr of the server to the stderr of this process.
+-- * @HLS_TEST_HARNESS_STDERR@: Log test setup messages.
+--
+-- Test specific environment variables:
+--
+-- * @HLS_TEST_PLUGIN_LOG_STDERR@: Log all messages of the hls plugin under test to stderr.
+-- * @HLS_TEST_LOG_STDERR@: Log all HLS messages to stderr.
+-- * @HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP@: Don't remove the test directories after test execution.
+--
 -- For more detail of the test configuration, see 'TestConfig'
 runSessionWithTestConfig :: Pretty b => TestConfig b -> (FilePath -> Session a) -> IO a
 runSessionWithTestConfig TestConfig{..} session =
@@ -792,8 +838,10 @@ runSessionWithTestConfig TestConfig{..} session =
                 else f
         runSessionInVFS (Left testConfigRoot) act = do
             root <- makeAbsolute testConfigRoot
-            act root
-        runSessionInVFS (Right vfs) act = runWithLockInTempDir vfs $ \fs -> act (fsRoot fs)
+            withTemporaryDataAndCacheDirectory (const $ act root)
+        runSessionInVFS (Right vfs) act =
+            withVfsTestDataDirectory vfs $ \fs -> do
+                act (fsRoot fs)
         testingArgs prjRoot recorderIde plugins =
             let
                 arguments@Arguments{ argsHlsPlugins, argsIdeOptions, argsLspOptions } = defaultArguments (cmapWithPrio LogIDEMain recorderIde) prjRoot plugins