@@ -95,7 +95,7 @@ import System.Process.Extra (CreateProcess (cwd),
95
95
import Test.QuickCheck
96
96
-- import Test.QuickCheck.Instances ()
97
97
import Control.Concurrent.Async
98
- import Control.Lens (to , (^.) )
98
+ import Control.Lens (to , (^.) , (.~) )
99
99
import Control.Monad.Extra (whenJust )
100
100
import Data.Function ((&) )
101
101
import Data.IORef
@@ -133,6 +133,7 @@ import Test.Tasty.Ingredients.Rerun
133
133
import Test.Tasty.QuickCheck
134
134
import Text.Printf (printf )
135
135
import Text.Regex.TDFA ((=~) )
136
+ import Language.LSP.Types.Lens (workspace , didChangeWatchedFiles )
136
137
137
138
data Log
138
139
= LogGhcIde Ghcide. Log
@@ -421,9 +422,12 @@ diagnosticTests = testGroup "diagnostics"
421
422
let contentA = T. unlines [ " module ModuleA where" ]
422
423
_ <- createDoc " ModuleA.hs" " haskell" contentA
423
424
expectDiagnostics [(" ModuleB.hs" , [] )]
424
- , ignoreTestBecause " Flaky #2831" $ testSessionWait " add missing module (non workspace)" $ do
425
- -- need to canonicalize in Mac Os
426
- tmpDir <- liftIO $ canonicalizePath =<< getTemporaryDirectory
425
+ , testCase " add missing module (non workspace)" $
426
+ -- By default lsp-test sends FileWatched notifications for all files, which we don't want
427
+ -- as non workspace modules will not be watched by the LSP server.
428
+ -- To work around this, we tell lsp-test that our client doesn't have the
429
+ -- FileWatched capability, which is enough to disable the notifications
430
+ withTempDir $ \ tmpDir -> runInDir'' lspTestCapsNoFileWatches tmpDir " ." " ." [] $ do
427
431
let contentB = T. unlines
428
432
[ " module ModuleB where"
429
433
, " import ModuleA ()"
@@ -6306,7 +6310,18 @@ withLongTimeout = bracket_ (setEnv "LSP_TIMEOUT" "120" True) (unsetEnv "LSP_TIME
6306
6310
6307
6311
-- | Takes a directory as well as relative paths to where we should launch the executable as well as the session root.
6308
6312
runInDir' :: FilePath -> FilePath -> FilePath -> [String ] -> Session a -> IO a
6309
- runInDir' dir startExeIn startSessionIn extraOptions s = do
6313
+ runInDir' = runInDir'' lspTestCaps
6314
+
6315
+ runInDir''
6316
+ :: ClientCapabilities
6317
+ -> FilePath
6318
+ -> FilePath
6319
+ -> FilePath
6320
+ -> [String ]
6321
+ -> Session b
6322
+ -> IO b
6323
+ runInDir'' lspCaps dir startExeIn startSessionIn extraOptions s = do
6324
+
6310
6325
ghcideExe <- locateGhcideExecutable
6311
6326
let startDir = dir </> startExeIn
6312
6327
let projDir = dir </> startSessionIn
@@ -6326,10 +6341,11 @@ runInDir' dir startExeIn startSessionIn extraOptions s = do
6326
6341
-- Only sets HOME if it wasn't already set.
6327
6342
setEnv " HOME" " /homeless-shelter" False
6328
6343
conf <- getConfigFromEnv
6329
- runSessionWithConfig conf cmd lspTestCaps projDir $ do
6344
+ runSessionWithConfig conf cmd lspCaps projDir $ do
6330
6345
configureCheckProject False
6331
6346
s
6332
6347
6348
+
6333
6349
getConfigFromEnv :: IO SessionConfig
6334
6350
getConfigFromEnv = do
6335
6351
logColor <- fromMaybe True <$> checkEnv " LSP_TEST_LOG_COLOR"
@@ -6347,6 +6363,9 @@ getConfigFromEnv = do
6347
6363
lspTestCaps :: ClientCapabilities
6348
6364
lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True ) Nothing Nothing }
6349
6365
6366
+ lspTestCapsNoFileWatches :: ClientCapabilities
6367
+ lspTestCapsNoFileWatches = lspTestCaps & workspace . Lens. _Just . didChangeWatchedFiles .~ Nothing
6368
+
6350
6369
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
6351
6370
openTestDataDoc path = do
6352
6371
source <- liftIO $ readFileUtf8 $ " test/data" </> path
0 commit comments