@@ -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,16 +422,16 @@ 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
+ withTempDir $ \ tmpDir -> runInDir'' lspTestCapsNoFileWatches tmpDir " ." " ." [] $ do
427
427
let contentB = T. unlines
428
428
[ " module ModuleB where"
429
429
, " import ModuleA ()"
430
430
]
431
431
_ <- createDoc (tmpDir </> " ModuleB.hs" ) " haskell" contentB
432
432
expectDiagnostics [(tmpDir </> " ModuleB.hs" , [(DsError , (1 , 7 ), " Could not find module" )])]
433
433
let contentA = T. unlines [ " module ModuleA where" ]
434
+ -- liftIO $ writeFile (tmpDir </> "ModuleA.hs") $ T.unpack contentA
434
435
_ <- createDoc (tmpDir </> " ModuleA.hs" ) " haskell" contentA
435
436
expectDiagnostics [(tmpDir </> " ModuleB.hs" , [] )]
436
437
, testSessionWait " cyclic module dependency" $ do
@@ -6306,7 +6307,18 @@ withLongTimeout = bracket_ (setEnv "LSP_TIMEOUT" "120" True) (unsetEnv "LSP_TIME
6306
6307
6307
6308
-- | Takes a directory as well as relative paths to where we should launch the executable as well as the session root.
6308
6309
runInDir' :: FilePath -> FilePath -> FilePath -> [String ] -> Session a -> IO a
6309
- runInDir' dir startExeIn startSessionIn extraOptions s = do
6310
+ runInDir' = runInDir'' lspTestCaps
6311
+
6312
+ runInDir''
6313
+ :: ClientCapabilities
6314
+ -> FilePath
6315
+ -> FilePath
6316
+ -> FilePath
6317
+ -> [String ]
6318
+ -> Session b
6319
+ -> IO b
6320
+ runInDir'' lspCaps dir startExeIn startSessionIn extraOptions s = do
6321
+
6310
6322
ghcideExe <- locateGhcideExecutable
6311
6323
let startDir = dir </> startExeIn
6312
6324
let projDir = dir </> startSessionIn
@@ -6326,10 +6338,11 @@ runInDir' dir startExeIn startSessionIn extraOptions s = do
6326
6338
-- Only sets HOME if it wasn't already set.
6327
6339
setEnv " HOME" " /homeless-shelter" False
6328
6340
conf <- getConfigFromEnv
6329
- runSessionWithConfig conf cmd lspTestCaps projDir $ do
6341
+ runSessionWithConfig conf cmd lspCaps projDir $ do
6330
6342
configureCheckProject False
6331
6343
s
6332
6344
6345
+
6333
6346
getConfigFromEnv :: IO SessionConfig
6334
6347
getConfigFromEnv = do
6335
6348
logColor <- fromMaybe True <$> checkEnv " LSP_TEST_LOG_COLOR"
@@ -6347,6 +6360,9 @@ getConfigFromEnv = do
6347
6360
lspTestCaps :: ClientCapabilities
6348
6361
lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True ) Nothing Nothing }
6349
6362
6363
+ lspTestCapsNoFileWatches :: ClientCapabilities
6364
+ lspTestCapsNoFileWatches = lspTestCaps & workspace . Lens. _Just . didChangeWatchedFiles .~ Nothing
6365
+
6350
6366
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
6351
6367
openTestDataDoc path = do
6352
6368
source <- liftIO $ readFileUtf8 $ " test/data" </> path
0 commit comments