hls-test-utils 2.14.0.0 → 2.15.0.0
raw patch · 4 files changed
+88/−68 lines, 4 filesdep ~ghcidedep ~hls-plugin-apiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-plugin-api
API changes (from Hackage documentation)
+ Test.Hls.FileSystem: sources :: [Text] -> Content
+ Test.Hls.TestEnv: getTestRootDir :: IO FilePath
Files
- hls-test-utils.cabal +3/−3
- src/Test/Hls.hs +43/−63
- src/Test/Hls/FileSystem.hs +6/−1
- src/Test/Hls/TestEnv.hs +36/−1
hls-test-utils.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-test-utils-version: 2.14.0.0+version: 2.15.0.0 synopsis: Utilities used in the tests of Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -44,8 +44,8 @@ , directory , extra , filepath- , ghcide == 2.14.0.0- , hls-plugin-api == 2.14.0.0+ , ghcide == 2.15.0.0+ , hls-plugin-api == 2.15.0.0 , lens , lsp , lsp-test ^>=0.18
src/Test/Hls.hs view
@@ -106,6 +106,9 @@ import Development.IDE.Plugin.Test (TestRequest (GetBuildKeysBuilt, WaitForIdeRule, WaitForShakeQueue), WaitForIdeRuleResult (ideResultSuccess)) import qualified Development.IDE.Plugin.Test as Test+import Development.IDE.Session (SessionLoadingOptions (..),+ getHieDbLocIn)+import Development.IDE.Session.Ghc (getCacheDirsIn) import Development.IDE.Types.Options import GHC.IO.Handle import GHC.TypeLits@@ -134,10 +137,9 @@ import System.Directory (canonicalizePath, createDirectoryIfMissing, getCurrentDirectory,- getTemporaryDirectory, makeAbsolute, setCurrentDirectory)-import System.Environment (lookupEnv, setEnv)+import System.Environment (lookupEnv) import System.FilePath import System.IO.Extra (newTempDirWithin) import System.IO.Unsafe (unsafePerformIO)@@ -145,7 +147,8 @@ import System.Time.Extra import qualified Test.Hls.FileSystem as FS import Test.Hls.FileSystem-import Test.Hls.TestEnv (hlsTestOptions,+import Test.Hls.TestEnv (getTestRootDir,+ hlsTestOptions, wrapCliTestOptions) import Test.Hls.Util import Test.Tasty hiding (Timeout)@@ -533,16 +536,16 @@ {testLspConfig=config, testPluginDescriptor = plugin, testDirLocation=Right tree} (const act) --- | Same as 'withTemporaryDataAndCacheDirectory', but materialises the given--- 'VirtualFileTree' in the temporary directory.-withVfsTestDataDirectory :: VirtualFileTree -> (FileSystem -> IO a) -> IO a+-- | Like 'withTemporaryDataAndCacheDirectory', but first materialises the given+-- 'VirtualFileTree'. The continuation receives the per-test cache directory.+withVfsTestDataDirectory :: VirtualFileTree -> (FileSystem -> FilePath -> IO a) -> IO a withVfsTestDataDirectory tree act = do- withTemporaryDataAndCacheDirectory $ \tmpRoot -> do+ withTemporaryDataAndCacheDirectory $ \tmpRoot cacheDir -> do fs <- FS.materialiseVFT tmpRoot tree- act fs+ act fs cacheDir --- | Run an action in a temporary directory.--- Sets the 'XDG_CACHE_HOME' environment variable to a temporary directory as well.+-- | Run an action in a temporary directory, passing it both the test root and a+-- fresh cache directory. -- -- This sets up a temporary directory for HLS tests to run. -- Typically, HLS tests copy their test data into the directory and then launch@@ -550,11 +553,10 @@ -- 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+-- For isolation, each test gets its own cache directory wired into the server+-- via 'argsGetHieDbLoc' and 'getCacheDirs'.+withTemporaryDataAndCacheDirectory :: (FilePath -> FilePath -> IO a) -> IO a+withTemporaryDataAndCacheDirectory act = do testRoot <- setupTestEnvironment helperRecorder <- hlsHelperTestRecorder -- Do not clean up the temporary directory if this variable is set to anything but '0'.@@ -562,44 +564,28 @@ cleanupTempDir <- lookupEnv "HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP" let runTestInDir action = case cleanupTempDir of Just val | val /= "0" -> do- (tempDir, cacheHome, _) <- setupTemporaryTestDirectories testRoot- a <- withTempCacheHome cacheHome (action tempDir)+ (tempDir, cacheDir, _) <- setupTemporaryTestDirectories testRoot+ a <- action tempDir cacheDir logWith helperRecorder Debug LogNoCleanup pure a _ -> do- (tempDir, cacheHome, cleanup) <- setupTemporaryTestDirectories testRoot- a <- withTempCacheHome cacheHome (action tempDir) `finally` cleanup+ (tempDir, cacheDir, cleanup) <- setupTemporaryTestDirectories testRoot+ a <- action tempDir cacheDir `finally` cleanup logWith helperRecorder Debug LogCleanup pure a- runTestInDir $ \tmpDir' -> do+ runTestInDir $ \tmpDir' cacheDir -> do -- we canonicalize the path, so that we do not need to do -- canonicalization during the test when we compare two paths tmpDir <- canonicalizePath tmpDir' logWith helperRecorder Info $ LogTestDir tmpDir- act tmpDir+ act tmpDir cacheDir 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.+ -- A fresh cache directory per test gives empty, independent caches. setupTemporaryTestDirectories testRoot = do (tempTestCaseDir, cleanup1) <- newTempDirWithin testRoot- (tempCacheHomeDir, cleanup2) <- newTempDirWithin testRoot- pure (tempTestCaseDir, tempCacheHomeDir, cleanup1 >> cleanup2)+ (tempCacheDir, cleanup2) <- newTempDirWithin testRoot+ pure (tempTestCaseDir, tempCacheDir, cleanup1 >> cleanup2) runSessionWithServer :: Pretty b => Config -> PluginTestDescriptor b -> FilePath -> Session a -> IO a runSessionWithServer config plugin fp act =@@ -634,16 +620,9 @@ -- However, it is totally safe to delete the directory between runs. setupTestEnvironment :: IO FilePath setupTestEnvironment = do- mRootDir <- lookupEnv "HLS_TEST_ROOTDIR"- case mRootDir of- Nothing -> do- tmpDirRoot <- getTemporaryDirectory- let testRoot = tmpDirRoot </> "hls-test-root"- createDirectoryIfMissing True testRoot- pure testRoot- Just rootDir -> do- createDirectoryIfMissing True rootDir- pure rootDir+ testRoot <- getTestRootDir+ createDirectoryIfMissing True testRoot+ pure testRoot goldenWithHaskellDocFormatter :: Pretty b@@ -750,12 +729,6 @@ lock :: Lock lock = unsafePerformIO newLock --{-# NOINLINE lockForTempDirs #-}--- | Never run in parallel-lockForTempDirs :: Lock-lockForTempDirs = unsafePerformIO newLock- data TestConfig b = TestConfig { testDirLocation :: Either FilePath VirtualFileTree@@ -830,7 +803,7 @@ -- For more detail of the test configuration, see 'TestConfig' runSessionWithTestConfig :: Pretty b => TestConfig b -> (FilePath -> Session a) -> IO a runSessionWithTestConfig TestConfig{..} session =- runSessionInVFS testDirLocation $ \root -> shiftRoot root $ do+ runSessionInVFS testDirLocation $ \root cacheDir -> shiftRoot root $ do pipeIn@(inR, inW) <- createPipe pipeOut@(outR, outW) <- createPipe let serverRoot = fromMaybe root testServerRoot@@ -850,7 +823,7 @@ let plugins = testPluginDescriptor recorder <> lspRecorderPlugin timeoutOverride <- fmap read <$> lookupEnv "LSP_TIMEOUT" let sconf' = testConfigSession { lspConfig = hlsConfigToClientConfig testLspConfig, messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride}- arguments = testingArgs serverRoot recorderIde plugins+ arguments = testingArgs serverRoot cacheDir recorderIde plugins -- Make an explicit call to keepAlive to protect both pipes from being GC'd. --@@ -882,13 +855,13 @@ else f runSessionInVFS (Left testConfigRoot) act = do root <- makeAbsolute testConfigRoot- withTemporaryDataAndCacheDirectory (const $ act root)+ withTemporaryDataAndCacheDirectory (\_ cacheDir -> act root cacheDir) runSessionInVFS (Right vfs) act =- withVfsTestDataDirectory vfs $ \fs -> do- act (fsRoot fs)- testingArgs prjRoot recorderIde plugins =+ withVfsTestDataDirectory vfs $ \fs cacheDir -> do+ act (fsRoot fs) cacheDir+ testingArgs prjRoot cacheDir recorderIde plugins = let- arguments@Arguments{ argsHlsPlugins, argsIdeOptions, argsLspOptions } = defaultArguments (cmapWithPrio LogIDEMain recorderIde) prjRoot plugins+ arguments@Arguments{ argsHlsPlugins, argsIdeOptions, argsLspOptions, argsSessionLoadingOptions } = defaultArguments (cmapWithPrio LogIDEMain recorderIde) prjRoot plugins argsHlsPlugins' = if testDisableDefaultPlugin then plugins else argsHlsPlugins@@ -906,6 +879,13 @@ , argsDefaultHlsConfig = testLspConfig , argsProjectRoot = prjRoot , argsDisableKick = testDisableKick+ -- Keep interface files and the hiedb under this test's cache+ -- directory instead of the shared 'XDG_CACHE_HOME'.+ , argsGetHieDbLoc = getHieDbLocIn cacheDir+ , argsSessionLoadingOptions = argsSessionLoadingOptions+ { getCacheDirs = \prefix mFirstHash opts ->+ pure $ getCacheDirsIn cacheDir prefix mFirstHash opts+ } } -- | Wait for the next progress begin step
src/Test/Hls/FileSystem.hs view
@@ -19,6 +19,7 @@ , copy , directory , text+ , sources , ref , copyDir -- * Cradle helpers@@ -178,9 +179,13 @@ directory :: FilePath -> [FileTree] -> FileTree directory name nodes = Directory name nodes --- | Write the given test directly into a file.+-- | Write the given text directly into a file. text :: T.Text -> Content text = Inline++-- | Write the given lines directly into a file.+sources :: [T.Text] -> Content+sources = Inline . T.unlines -- | Read the contents of the given file -- The filepath is always resolved to the root of the test data dir.
src/Test/Hls/TestEnv.hs view
@@ -7,13 +7,18 @@ , LspTimeout(..) , hlsTestOptions , wrapCliTestOptions+ , getTestRootDir ) where import Control.Monad (guard) import Data.Data (Proxy (..)) import Data.Foldable (traverse_) import Data.Maybe (catMaybes)+import System.Directory (createDirectoryIfMissing,+ getTemporaryDirectory, makeAbsolute,+ removePathForcibly) import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath ((</>)) import Test.Tasty (TestTree, askOption, withResource) import Test.Tasty.Options (IsOption (defaultValue, optionCLParser, optionHelp, optionName, parseValue), OptionDescription (..), flagCLParser,@@ -92,7 +97,37 @@ , ("HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP", "1") <$ guard harnessNoTestdirCleanup , ("LSP_TIMEOUT",) . show <$> timeout ]- in withResource (setOverrides overrides) restoreEnvs (const tree)+ in withRunEnv overrides tree++-- | Root directory for all test files. Honours 'HLS_TEST_ROOTDIR', else the+-- system temp directory.+getTestRootDir :: IO FilePath+getTestRootDir = do+ mRootDir <- lookupEnv "HLS_TEST_ROOTDIR"+ makeAbsolute =<< case mRootDir of+ Just rootDir -> pure rootDir+ Nothing -> (</> "hls-test-root") <$> getTemporaryDirectory++-- | Apply the per-run environment around the wrapped tests, then restore it and+-- drop the hie-bios cache.+--+-- NB: Needs to be applied once, before any test thread starts, because mutating+-- the process environment is inherently thread-unsafe.+withRunEnv :: [(String, String)] -> TestTree -> TestTree+withRunEnv overrides tree = withResource acquire release (const tree)+ where+ acquire = do+ saved <- setOverrides overrides+ hieBiosCacheDir <- (</> "hie-bios") <$> getTestRootDir+ createDirectoryIfMissing True hieBiosCacheDir+ -- TODO: Until the following PR is merged, tests cannot run concurrently+ -- using this single directory: https://github.com/haskell/hie-bios/pull/520+ savedHieBios <- setOverrides [("HIE_BIOS_CACHE_DIR", hieBiosCacheDir)]+ pure (saved ++ savedHieBios, hieBiosCacheDir)++ release (saved, hieBiosCacheDir) = do+ restoreEnvs saved+ removePathForcibly hieBiosCacheDir setOverrides :: [(String, String)] -> IO [(String, Maybe String)] setOverrides = traverse $ \(k, v) -> do