Skip to content

Commit aadf028

Browse files
soulomoonsoulomoon
committed
use wrapper version to provide file system
1 parent 9757e93 commit aadf028

File tree

3 files changed

+100
-75
lines changed

3 files changed

+100
-75
lines changed

‎ghcide/test/exe/Config.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ import Ide.Types (defaultPluginDescriptor)
66
import System.FilePath ((</>))
77
import Test.Hls
88
import qualified Test.Hls.FileSystem as FS
9+
import Test.Hls.FileSystem (FileSystem)
910

1011
testDataDir :: FilePath
1112
testDataDir = "ghcide" </> "test" </> "data"
@@ -17,12 +18,18 @@ mkIdeTestFs = FS.mkVirtualFileTree testDataDir
1718
dummyPlugin :: PluginTestDescriptor ()
1819
dummyPlugin = mkPluginTestDescriptor (\_ pid -> defaultPluginDescriptor pid "dummyTestPlugin") "core"
1920

20-
runWithDummyPlugin :: (TestRunner cont a) => FS.VirtualFileTree -> cont -> IO a
21+
runWithDummyPlugin :: FS.VirtualFileTree -> Session a -> IO a
2122
runWithDummyPlugin = runSessionWithServerInTmpDir def dummyPlugin
2223

24+
runWithDummyPlugin' :: FS.VirtualFileTree -> (FileSystem -> Session a) -> IO a
25+
runWithDummyPlugin' = runSessionWithServerInTmpDirCont' def dummyPlugin
26+
2327
-- testSessionWithCorePlugin ::(TestRunner cont ()) => TestName -> FS.VirtualFileTree -> cont -> TestTree
24-
testWithDummyPlugin :: (TestRunner cont ()) => String -> FS.VirtualFileTree -> cont -> TestTree
28+
testWithDummyPlugin :: String -> FS.VirtualFileTree -> Session () -> TestTree
2529
testWithDummyPlugin caseName vfs = testCase caseName . runWithDummyPlugin vfs
2630

31+
testWithDummyPlugin' :: String -> FS.VirtualFileTree -> (FileSystem -> Session ()) -> TestTree
32+
testWithDummyPlugin' caseName vfs = testCase caseName . runWithDummyPlugin' vfs
33+
2734
pattern R :: UInt -> UInt -> UInt -> UInt -> Range
2835
pattern R x y x' y' = Range (Position x y) (Position x' y')

‎ghcide/test/exe/ReferenceTests.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -169,7 +169,7 @@ getReferences' (file, l, c) includeDeclaration = do
169169

170170
referenceTestSession :: String -> FilePath -> [FilePath] -> Session () -> TestTree
171171
referenceTestSession name thisDoc docs' f = do
172-
testWithDummyPlugin name (mkIdeTestFs [copyDir "references"]) $ \fs -> do
172+
testWithDummyPlugin' name (mkIdeTestFs [copyDir "references"]) $ \fs -> do
173173
-- needed to build whole project indexing
174174
configureCheckProject True
175175
-- need to get the real paths through links

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

Lines changed: 90 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,8 @@ module Test.Hls
3333
runSessionWithServerAndCapsInTmpDir,
3434
runSessionWithServer',
3535
runSessionWithServerInTmpDir',
36-
-- * polymorphic test runner so we can expose different continuation
37-
TestRunner,
36+
-- continuation version that take a FileSystem
37+
runSessionWithServerInTmpDirCont',
3838
-- * Helpful re-exports
3939
PluginDescriptor,
4040
IdeState,
@@ -365,78 +365,96 @@ initialiseTestRecorder envVars = do
365365
-- ------------------------------------------------------------
366366
-- Run an HLS server testing a specific plugin
367367
-- ------------------------------------------------------------
368-
class TestRunner cont res where
369-
runSessionWithServerInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> cont -> IO res
370-
runSessionWithServerInTmpDir config plugin tree act = do
371-
recorder <- pluginTestRecorder
372-
runSessionWithServerInTmpDir' (plugin recorder) config def fullCaps tree act
373-
runSessionWithServerAndCapsInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> cont -> IO res
374-
runSessionWithServerAndCapsInTmpDir config plugin caps tree act = do
375-
recorder <- pluginTestRecorder
376-
runSessionWithServerInTmpDir' (plugin recorder) config def caps tree act
377-
378-
-- | Host a server, and run a test session on it.
379-
--
380-
-- Creates a temporary directory, and materializes the VirtualFileTree
381-
-- in the temporary directory.
382-
--
383-
-- To debug test cases and verify the file system is correctly set up,
384-
-- you should set the environment variable 'HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1'.
385-
-- Further, we log the temporary directory location on startup. To view
386-
-- the logs, set the environment variable 'HLS_TEST_HARNESS_STDERR=1'.
387-
--
388-
-- Example invocation to debug test cases:
389-
--
390-
-- @
391-
-- HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 HLS_TEST_HARNESS_STDERR=1 cabal test <plugin-name>
392-
-- @
393-
--
394-
-- Don't forget to use 'TASTY_PATTERN' to debug only a subset of tests.
368+
runSessionWithServerInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> Session a -> IO a
369+
runSessionWithServerInTmpDir config plugin tree act = runSessionWithServerInTmpDirCont' config plugin tree (const act)
370+
371+
runSessionWithServerAndCapsInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> Session a -> IO a
372+
runSessionWithServerAndCapsInTmpDir config plugin caps tree act = runSessionWithServerAndCapsInTmpDirCont config plugin caps tree (const act)
373+
374+
runSessionWithServerInTmpDirCont' :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> (FileSystem -> Session a) -> IO a
375+
runSessionWithServerInTmpDirCont' config plugin tree act = do
376+
recorder <- pluginTestRecorder
377+
runSessionWithServerInTmpDirCont (plugin recorder) config def fullCaps tree act
378+
379+
runSessionWithServerAndCapsInTmpDirCont :: Pretty b => Config -> PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> (FileSystem -> Session a) -> IO a
380+
runSessionWithServerAndCapsInTmpDirCont config plugin caps tree act = do
381+
recorder <- pluginTestRecorder
382+
runSessionWithServerInTmpDirCont (plugin recorder) config def caps tree act
383+
384+
runSessionWithServerInTmpDir' ::
385+
-- | Plugins to load on the server.
395386
--
396-
-- For plugin test logs, look at the documentation of 'mkPluginTestDescriptor'.
387+
-- For improved logging, make sure these plugins have been initalised with
388+
-- the recorder produced by @pluginTestRecorder@.
389+
IdePlugins IdeState ->
390+
-- | lsp config for the server
391+
Config ->
392+
-- | config for the test session
393+
SessionConfig ->
394+
ClientCapabilities ->
395+
VirtualFileTree ->
396+
Session a -> IO a
397+
runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = runSessionWithServerInTmpDirCont plugins conf sessConf caps tree (const act)
398+
399+
-- | Host a server, and run a test session on it.
400+
--
401+
-- Creates a temporary directory, and materializes the VirtualFileTree
402+
-- in the temporary directory.
403+
--
404+
-- To debug test cases and verify the file system is correctly set up,
405+
-- you should set the environment variable 'HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1'.
406+
-- Further, we log the temporary directory location on startup. To view
407+
-- the logs, set the environment variable 'HLS_TEST_HARNESS_STDERR=1'.
408+
--
409+
-- Example invocation to debug test cases:
410+
--
411+
-- @
412+
-- HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 HLS_TEST_HARNESS_STDERR=1 cabal test <plugin-name>
413+
-- @
414+
--
415+
-- Don't forget to use 'TASTY_PATTERN' to debug only a subset of tests.
416+
--
417+
-- For plugin test logs, look at the documentation of 'mkPluginTestDescriptor'.
418+
--
419+
-- Note: cwd will be shifted into a temporary directory in @Session a@
420+
runSessionWithServerInTmpDirCont ::
421+
-- | Plugins to load on the server.
397422
--
398-
-- Note: cwd will be shifted into a temporary directory in @Session a@
399-
runSessionWithServerInTmpDir' ::
400-
-- | Plugins to load on the server.
401-
--
402-
-- For improved logging, make sure these plugins have been initalised with
403-
-- the recorder produced by @pluginTestRecorder@.
404-
IdePlugins IdeState ->
405-
-- | lsp config for the server
406-
Config ->
407-
-- | config for the test session
408-
SessionConfig ->
409-
ClientCapabilities ->
410-
VirtualFileTree ->
411-
cont -> IO res
412-
runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
413-
testRoot <- setupTestEnvironment
414-
recorder <- initialiseTestRecorder
415-
["LSP_TEST_LOG_STDERR", "HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
416-
417-
-- Do not clean up the temporary directory if this variable is set to anything but '0'.
418-
-- Aids debugging.
419-
cleanupTempDir <- lookupEnv "HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
420-
let runTestInDir action = case cleanupTempDir of
421-
Just val | val /= "0" -> do
422-
(tempDir, _) <- newTempDirWithin testRoot
423-
a <- action tempDir
424-
logWith recorder Debug LogNoCleanup
425-
pure a
426-
427-
_ -> do
428-
(tempDir, cleanup) <- newTempDirWithin testRoot
429-
a <- action tempDir `finally` cleanup
430-
logWith recorder Debug LogCleanup
431-
pure a
432-
433-
runTestInDir $ \tmpDir -> do
434-
logWith recorder Info $ LogTestDir tmpDir
435-
fs <- FS.materialiseVFT tmpDir tree
436-
runSessionWithServer' plugins conf sessConf caps tmpDir (contToSessionRes fs act)
437-
contToSessionRes :: FileSystem -> cont -> Session res
438-
instance TestRunner (Session a) a where contToSessionRes _ act = act
439-
instance TestRunner (FileSystem -> Session a) a where contToSessionRes fs act = act fs
423+
-- For improved logging, make sure these plugins have been initalised with
424+
-- the recorder produced by @pluginTestRecorder@.
425+
IdePlugins IdeState ->
426+
-- | lsp config for the server
427+
Config ->
428+
-- | config for the test session
429+
SessionConfig ->
430+
ClientCapabilities ->
431+
VirtualFileTree ->
432+
(FileSystem -> Session a) -> IO a
433+
runSessionWithServerInTmpDirCont plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
434+
testRoot <- setupTestEnvironment
435+
recorder <- initialiseTestRecorder
436+
["LSP_TEST_LOG_STDERR", "HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
437+
438+
-- Do not clean up the temporary directory if this variable is set to anything but '0'.
439+
-- Aids debugging.
440+
cleanupTempDir <- lookupEnv "HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
441+
let runTestInDir action = case cleanupTempDir of
442+
Just val | val /= "0" -> do
443+
(tempDir, _) <- newTempDirWithin testRoot
444+
a <- action tempDir
445+
logWith recorder Debug LogNoCleanup
446+
pure a
447+
448+
_ -> do
449+
(tempDir, cleanup) <- newTempDirWithin testRoot
450+
a <- action tempDir `finally` cleanup
451+
logWith recorder Debug LogCleanup
452+
pure a
453+
454+
runTestInDir $ \tmpDir -> do
455+
logWith recorder Info $ LogTestDir tmpDir
456+
fs <- FS.materialiseVFT tmpDir tree
457+
runSessionWithServer' plugins conf sessConf caps tmpDir (act fs)
440458

441459
runSessionWithServer :: Pretty b => Config -> PluginTestDescriptor b -> FilePath -> Session a -> IO a
442460
runSessionWithServer config plugin fp act = do

0 commit comments

Comments
 (0)