Skip to content

Commit a3e4b95

Browse files
authored
[Migrate DependentFileTest] part of #4173 Migrate ghcide tests to hls test utils (#4195)
* wip trace flaky * clena up trace * cleanup * cleanup
1 parent 8afc65a commit a3e4b95

File tree

1 file changed

+6
-5
lines changed

1 file changed

+6
-5
lines changed

ghcide/test/exe/DependentFileTest.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44

55
module DependentFileTest (tests) where
66

7+
import Config
78
import Control.Monad.IO.Class (liftIO)
89
import Data.Row
910
import qualified Data.Text as T
@@ -16,19 +17,19 @@ import Language.LSP.Protocol.Types hiding
1617
SemanticTokensEdit (..),
1718
mkRange)
1819
import Language.LSP.Test
19-
import System.FilePath
20+
import Test.Hls.FileSystem (FileSystem, toAbsFp)
2021
import Test.Tasty
21-
import TestUtils
2222

2323
tests :: TestTree
2424
tests = testGroup "addDependentFile"
25-
[testGroup "file-changed" [testSession' "test" test]
25+
[testGroup "file-changed" [testWithDummyPlugin' "test" (mkIdeTestFs []) test]
2626
]
2727
where
28+
test :: FileSystem -> Session ()
2829
test dir = do
2930
-- If the file contains B then no type error
3031
-- otherwise type error
31-
let depFilePath = dir </> "dep-file.txt"
32+
let depFilePath = toAbsFp dir "dep-file.txt"
3233
liftIO $ writeFile depFilePath "A"
3334
let fooContent = T.unlines
3435
[ "{-# LANGUAGE TemplateHaskell #-}"
@@ -41,7 +42,7 @@ tests = testGroup "addDependentFile"
4142
, " if f == \"B\" then [| 1 |] else lift f)"
4243
]
4344
let bazContent = T.unlines ["module Baz where", "import Foo ()"]
44-
_ <- createDoc "Foo.hs" "haskell" fooContent
45+
_fooDoc <- createDoc "Foo.hs" "haskell" fooContent
4546
doc <- createDoc "Baz.hs" "haskell" bazContent
4647
expectDiagnostics
4748
[("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type")])]

0 commit comments

Comments
 (0)