do ReferenceTests

Author: soulomoon

ghcide/ghcide.cabal

@@ -388,7 +388,6 @@ test-suite ghcide-tests
     PositionMappingTests
     PreprocessorTests
     Progress
-    ReferenceTests
     RootUriTests
     SafeTests
     SymlinkTests

ghcide/test/data/hover/Bar.hs

@@ -67,7 +67,6 @@ import BootTests
 import RootUriTests
 import AsyncTests
 import ClientSettingsTests
-import ReferenceTests
 import GarbageCollectionTests
 import ExceptionTests
 
@@ -108,7 +107,6 @@ main = do
     , RootUriTests.tests
     , AsyncTests.tests
     , ClientSettingsTests.tests
-    , ReferenceTests.tests
     , GarbageCollectionTests.tests
     , HieDbRetry.tests
     , ExceptionTests.tests recorder logger

ghcide/test/data/hover/Foo.hs

@@ -1665,6 +1665,7 @@ test-suite hls-core-plugin-tests
     OutlineTests
     CompletionTests
     HighlightTests
+    ReferenceTests
 
 
   build-depends:
@@ -1690,6 +1691,8 @@ test-suite hls-core-plugin-tests
     , extra
     , hls-test-utils
     , regex-tdfa
+    , directory
+    , tasty-expected-failure
 
 
 -----------------------------

ghcide/test/data/hover/GotoHover.hs

@@ -29,6 +29,7 @@ module Test.Hls
     -- * Running HLS for integration tests
     runSessionWithServer,
     runSessionWithServerAndCaps,
+    TestRunner,
     runSessionWithServerInTmpDir,
     runSessionWithServerAndCapsInTmpDir,
     runSessionWithServer',
@@ -368,6 +369,86 @@ initialiseTestRecorder envVars = do
 -- ------------------------------------------------------------
 -- Run an HLS server testing a specific plugin
 -- ------------------------------------------------------------
+class TestRunner cont res where
+    runSessionWithServerInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> cont -> IO res
+    runSessionWithServerInTmpDir config plugin tree act = do
+        recorder <- pluginTestRecorder
+        runSessionWithServerInTmpDir' (plugin recorder) config def fullCaps tree act
+    runSessionWithServerAndCapsInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> cont -> IO res
+    runSessionWithServerAndCapsInTmpDir config plugin caps tree act = do
+        recorder <- pluginTestRecorder
+        runSessionWithServerInTmpDir' (plugin recorder) config def caps tree act
+
+    -- | Host a server, and run a test session on it.
+    --
+    -- Creates a temporary directory, and materializes the VirtualFileTree
+    -- in the temporary directory.
+    --
+    -- To debug test cases and verify the file system is correctly set up,
+    -- you should set the environment variable 'HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1'.
+    -- Further, we log the temporary directory location on startup. To view
+    -- the logs, set the environment variable 'HLS_TEST_HARNESS_STDERR=1'.
+    --
+    -- Example invocation to debug test cases:
+    --
+    -- @
+    --   HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 HLS_TEST_HARNESS_STDERR=1 cabal test <plugin-name>
+    -- @
+    --
+    -- Don't forget to use 'TASTY_PATTERN' to debug only a subset of tests.
+    --
+    -- For plugin test logs, look at the documentation of 'mkPluginTestDescriptor'.
+    --
+    -- Note: cwd will be shifted into a temporary directory in @Session a@
+    runSessionWithServerInTmpDir' ::
+        -- | Plugins to load on the server.
+        --
+        -- For improved logging, make sure these plugins have been initalised with
+        -- the recorder produced by @pluginTestRecorder@.
+        IdePlugins IdeState ->
+        -- | lsp config for the server
+        Config ->
+        -- | config for the test session
+        SessionConfig ->
+        ClientCapabilities ->
+        VirtualFileTree ->
+        cont -> IO res
+    runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
+        testRoot <- setupTestEnvironment
+        (recorder, _) <- initialiseTestRecorder
+            ["LSP_TEST_LOG_STDERR", "HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
+
+        -- 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
+                    logWith recorder Debug LogNoCleanup
+                    pure a
+
+                _ -> do
+                    (tempDir, cleanup) <- newTempDirWithin testRoot
+                    a <- action tempDir `finally` cleanup
+                    logWith recorder Debug LogCleanup
+                    pure a
+
+        runTestInDir $ \tmpDir -> do
+            logWith recorder Info $ LogTestDir tmpDir
+            fs <- FS.materialiseVFT tmpDir tree
+            runSessionWithServer' plugins conf sessConf caps tmpDir (contToSessionRes fs act)
+    contToSessionRes :: FileSystem -> cont -> Session res
+
+
+instance TestRunner (Session a) a where
+    contToSessionRes _ act = act
+
+
+instance TestRunner (FileSystem -> Session a) a where
+    contToSessionRes fs act = act fs
+
+
 
 runSessionWithServer :: Pretty b => Config -> PluginTestDescriptor b -> FilePath -> Session a -> IO a
 runSessionWithServer config plugin fp act = do
@@ -379,77 +460,6 @@ runSessionWithServerAndCaps config plugin caps fp act = do
   recorder <- pluginTestRecorder
   runSessionWithServer' (plugin recorder) config def caps fp act
 
-runSessionWithServerInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> Session a -> IO a
-runSessionWithServerInTmpDir config plugin tree act = do
-  recorder <- pluginTestRecorder
-  runSessionWithServerInTmpDir' (plugin recorder) config def fullCaps tree act
-
-runSessionWithServerAndCapsInTmpDir :: Pretty b => Config ->  PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> Session a -> IO a
-runSessionWithServerAndCapsInTmpDir config plugin caps tree act = do
-  recorder <- pluginTestRecorder
-  runSessionWithServerInTmpDir' (plugin recorder) config def caps tree act
-
--- | Host a server, and run a test session on it.
---
--- Creates a temporary directory, and materializes the VirtualFileTree
--- in the temporary directory.
---
--- To debug test cases and verify the file system is correctly set up,
--- you should set the environment variable 'HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1'.
--- Further, we log the temporary directory location on startup. To view
--- the logs, set the environment variable 'HLS_TEST_HARNESS_STDERR=1'.
---
--- Example invocation to debug test cases:
---
--- @
---   HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 HLS_TEST_HARNESS_STDERR=1 cabal test <plugin-name>
--- @
---
--- Don't forget to use 'TASTY_PATTERN' to debug only a subset of tests.
---
--- For plugin test logs, look at the documentation of 'mkPluginTestDescriptor'.
---
--- Note: cwd will be shifted into a temporary directory in @Session a@
-runSessionWithServerInTmpDir' ::
-  -- | Plugins to load on the server.
-  --
-  -- For improved logging, make sure these plugins have been initalised with
-  -- the recorder produced by @pluginTestRecorder@.
-  IdePlugins IdeState ->
-  -- | lsp config for the server
-  Config ->
-  -- | config for the test session
-  SessionConfig ->
-  ClientCapabilities ->
-  VirtualFileTree ->
-  Session a ->
-  IO a
-runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
-  testRoot <- setupTestEnvironment
-  (recorder, _) <- initialiseTestRecorder
-    ["LSP_TEST_LOG_STDERR", "HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
-
-  -- 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
-            logWith recorder Debug LogNoCleanup
-            pure a
-
-        _ -> do
-          (tempDir, cleanup) <- newTempDirWithin testRoot
-          a <- action tempDir `finally` cleanup
-          logWith recorder Debug LogCleanup
-          pure a
-
-  runTestInDir $ \tmpDir -> do
-    logWith recorder Info $ LogTestDir tmpDir
-    _fs <- FS.materialiseVFT tmpDir tree
-    runSessionWithServer' plugins conf sessConf caps tmpDir act
 
 -- | Setup the test environment for isolated tests.
 --

ghcide/test/data/hover/RecordDotSyntax.hs

@@ -20,6 +20,7 @@ module Test.Hls.FileSystem
   , directory
   , text
   , ref
+  , copyDir
   -- * Cradle helpers
   , directCradle
   , simpleCabalCradle
@@ -66,6 +67,7 @@ data VirtualFileTree =
 data FileTree
   = File FilePath Content
   | Directory FilePath [FileTree]
+  | CopiedDirectory FilePath
   deriving (Show, Eq, Ord)
 
 data Content
@@ -99,12 +101,15 @@ materialise rootDir' fileTree testDataDir' = do
       rootDir = FP.normalise rootDir'
 
       persist :: FilePath -> FileTree -> IO ()
-      persist fp (File name cts) = case cts of
-        Inline txt -> T.writeFile (fp </> name) txt
-        Ref path -> copyFile (testDataDir </> FP.normalise path) (fp </> takeFileName name)
-      persist fp (Directory name nodes) = do
-        createDirectory (fp </> name)
-        mapM_ (persist (fp </> name)) nodes
+      persist root (File name cts) = case cts of
+        Inline txt -> T.writeFile (root </> name) txt
+        Ref path -> copyFile (testDataDir </> FP.normalise path) (root </> takeFileName name)
+      persist root (Directory name nodes) = do
+        createDirectory (root </> name)
+        mapM_ (persist (root </> name)) nodes
+      persist root (CopiedDirectory name) = do
+        nodes <- copyDir' testDataDir' name
+        mapM_ (persist root) nodes
 
   traverse_ (persist rootDir) fileTree
   pure $ FileSystem rootDir fileTree testDataDir
@@ -154,6 +159,15 @@ file fp cts = File fp cts
 copy :: FilePath -> FileTree
 copy fp = File fp (Ref fp)
 
+copyDir :: FilePath -> FileTree
+copyDir dir = CopiedDirectory dir
+
+-- | Copy a directory into a test project.
+copyDir' :: FilePath -> FilePath -> IO [FileTree]
+copyDir' root dir = do
+  files <- listDirectory (root </> dir)
+  traverse (\f -> pure $ copy (dir </> f)) files
+
 directory :: FilePath -> [FileTree] -> FileTree
 directory name nodes = Directory name nodes