Skip to content

Commit 8afc65a

Browse files
soulomoonsoulomoon
authored
[Migrate CompletionTests] part of 4173 Migrate ghcide tests to hls test utils (#4192)
* migrate ghcide-tests CompletionTests to hls-test-utils * cleanup
1 parent 8ef854a commit 8afc65a

File tree

1 file changed

+47
-42
lines changed

1 file changed

+47
-42
lines changed

‎ghcide/test/exe/CompletionTests.hs

+47-42
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,13 @@
11

2-
{-# LANGUAGE GADTs #-}
3-
{-# LANGUAGE OverloadedLabels #-}
2+
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE OverloadedLabels #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE RecordWildCards #-}
47

58
module CompletionTests (tests) where
69

10+
import Config
711
import Control.Lens ((^.))
812
import qualified Control.Lens as Lens
913
import Control.Monad
@@ -14,7 +18,6 @@ import Data.Maybe
1418
import Data.Row
1519
import qualified Data.Text as T
1620
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
17-
import Development.IDE.Test (waitForTypecheck)
1821
import Development.IDE.Types.Location
1922
import Ide.Plugin.Config
2023
import qualified Language.LSP.Protocol.Lens as L
@@ -25,10 +28,12 @@ import Language.LSP.Protocol.Types hiding
2528
SemanticTokensEdit (..),
2629
mkRange)
2730
import Language.LSP.Test
28-
import System.FilePath
31+
import Test.Hls (waitForTypecheck)
32+
import qualified Test.Hls.FileSystem as FS
33+
import Test.Hls.FileSystem (file, text)
34+
import Test.Hls.Util (knownBrokenOnWindows)
2935
import Test.Tasty
3036
import Test.Tasty.HUnit
31-
import TestUtils
3237

3338

3439
tests :: TestTree
@@ -44,9 +49,19 @@ tests
4449
, testGroup "doc" completionDocTests
4550
]
4651

52+
testSessionEmpty :: TestName -> Session () -> TestTree
53+
testSessionEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]])
54+
55+
testSessionEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree
56+
testSessionEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)])
57+
58+
testSessionSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree
59+
testSessionSingleFile testName fp txt session =
60+
testWithDummyPlugin testName (mkIdeTestFs [FS.directCradle [T.pack fp] , file fp (text txt)]) session
61+
4762
completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, CompletionItemKind, T.Text, Bool, Bool, Maybe [TextEdit])] -> TestTree
48-
completionTest name src pos expected = testSessionWait name $ do
49-
docId <- createDoc "A.hs" "haskell" (T.unlines src)
63+
completionTest name src pos expected = testSessionSingleFile name "A.hs" (T.unlines src) $ do
64+
docId <- openDoc "A.hs" "haskell"
5065
_ <- waitForDiagnostics
5166
compls <- getAndResolveCompletions docId pos
5267
let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls]
@@ -185,7 +200,7 @@ localCompletionTests = [
185200
[("abcd", CompletionItemKind_Function, "abcd", True, False, Nothing)
186201
,("abcde", CompletionItemKind_Function, "abcde", True, False, Nothing)
187202
],
188-
testSessionWait "incomplete entries" $ do
203+
testSessionEmpty "incomplete entries" $ do
189204
let src a = "data Data = " <> a
190205
doc <- createDoc "A.hs" "haskell" $ src "AAA"
191206
void $ waitForTypecheck doc
@@ -261,7 +276,7 @@ nonLocalCompletionTests =
261276
[]
262277
]
263278
where
264-
brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC92, GHC94, GHC96, GHC98]) "Windows has strange things in scope for some reason"
279+
brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason"
265280

266281
otherCompletionTests :: [TestTree]
267282
otherCompletionTests = [
@@ -283,7 +298,7 @@ otherCompletionTests = [
283298
(Position 3 11)
284299
[("Integer", CompletionItemKind_Struct, "Integer", True, True, Nothing)],
285300

286-
testSession "duplicate record fields" $ do
301+
testSessionEmpty "duplicate record fields" $ do
287302
void $
288303
createDoc "B.hs" "haskell" $
289304
T.unlines
@@ -304,22 +319,21 @@ otherCompletionTests = [
304319
let compls' = [txt | CompletionItem {_insertText = Just txt, ..} <- compls, _label == "member"]
305320
liftIO $ take 1 compls' @?= ["member"],
306321

307-
testSessionWait "maxCompletions" $ do
322+
testSessionEmpty "maxCompletions" $ do
308323
doc <- createDoc "A.hs" "haskell" $ T.unlines
309324
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
310325
"module A () where",
311326
"a = Prelude."
312327
]
313328
_ <- waitForDiagnostics
314-
compls <- getCompletions doc (Position 3 13)
329+
compls <- getCompletions doc (Position 3 13)
315330
liftIO $ length compls @?= maxCompletions def
316331
]
317332

318333
packageCompletionTests :: [TestTree]
319334
packageCompletionTests =
320-
[ testSession' "fromList" $ \dir -> do
321-
liftIO $ writeFile (dir </> "hie.yaml")
322-
"cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}"
335+
[ testSessionEmptyWithCradle "fromList" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" $ do
336+
323337
doc <- createDoc "A.hs" "haskell" $ T.unlines
324338
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
325339
"module A () where",
@@ -337,9 +351,9 @@ packageCompletionTests =
337351
map ("Defined in "<>) (
338352
[ "'Data.List.NonEmpty"
339353
, "'GHC.Exts"
340-
] ++ if ghcVersion >= GHC94 then [ "'GHC.IsList" ] else [])
354+
] ++ (["'GHC.IsList" | ghcVersion >= GHC94]))
341355

342-
, testSessionWait "Map" $ do
356+
, testSessionEmpty "Map" $ do
343357
doc <- createDoc "A.hs" "haskell" $ T.unlines
344358
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
345359
"module A () where",
@@ -359,7 +373,7 @@ packageCompletionTests =
359373
, "'Data.Map.Lazy"
360374
, "'Data.Map.Strict"
361375
]
362-
, testSessionWait "no duplicates" $ do
376+
, testSessionEmpty "no duplicates" $ do
363377
doc <- createDoc "A.hs" "haskell" $ T.unlines
364378
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
365379
"module A () where",
@@ -381,7 +395,7 @@ packageCompletionTests =
381395
) compls
382396
liftIO $ length duplicate @?= 1
383397

384-
, testSessionWait "non-local before global" $ do
398+
, testSessionEmpty "non-local before global" $ do
385399
-- non local completions are more specific
386400
doc <- createDoc "A.hs" "haskell" $ T.unlines
387401
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
@@ -402,9 +416,7 @@ packageCompletionTests =
402416

403417
projectCompletionTests :: [TestTree]
404418
projectCompletionTests =
405-
[ testSession' "from hiedb" $ \dir-> do
406-
liftIO $ writeFile (dir </> "hie.yaml")
407-
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
419+
[ testSessionEmptyWithCradle "from hiedb" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
408420
_ <- createDoc "A.hs" "haskell" $ T.unlines
409421
[ "module A (anidentifier) where",
410422
"anidentifier = ()"
@@ -423,9 +435,7 @@ projectCompletionTests =
423435
, _label == "anidentifier"
424436
]
425437
liftIO $ compls' @?= ["Defined in 'A"],
426-
testSession' "auto complete project imports" $ \dir-> do
427-
liftIO $ writeFile (dir </> "hie.yaml")
428-
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}"
438+
testSessionEmptyWithCradle "auto complete project imports" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" $ do
429439
_ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines
430440
[ "module ALocalModule (anidentifier) where",
431441
"anidentifier = ()"
@@ -440,9 +450,7 @@ projectCompletionTests =
440450
let item = head $ filter ((== "ALocalModule") . (^. L.label)) compls
441451
liftIO $ do
442452
item ^. L.label @?= "ALocalModule",
443-
testSession' "auto complete functions from qualified imports without alias" $ \dir-> do
444-
liftIO $ writeFile (dir </> "hie.yaml")
445-
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
453+
testSessionEmptyWithCradle "auto complete functions from qualified imports without alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
446454
_ <- createDoc "A.hs" "haskell" $ T.unlines
447455
[ "module A (anidentifier) where",
448456
"anidentifier = ()"
@@ -457,9 +465,8 @@ projectCompletionTests =
457465
let item = head compls
458466
liftIO $ do
459467
item ^. L.label @?= "anidentifier",
460-
testSession' "auto complete functions from qualified imports with alias" $ \dir-> do
461-
liftIO $ writeFile (dir </> "hie.yaml")
462-
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
468+
testSessionEmptyWithCradle "auto complete functions from qualified imports with alias"
469+
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
463470
_ <- createDoc "A.hs" "haskell" $ T.unlines
464471
[ "module A (anidentifier) where",
465472
"anidentifier = ()"
@@ -478,30 +485,30 @@ projectCompletionTests =
478485

479486
completionDocTests :: [TestTree]
480487
completionDocTests =
481-
[ testSession "local define" $ do
488+
[ testSessionEmpty "local define" $ do
482489
doc <- createDoc "A.hs" "haskell" $ T.unlines
483490
[ "module A where"
484491
, "foo = ()"
485492
, "bar = fo"
486493
]
487494
let expected = "*Defined at line 2, column 1 in this module*\n"
488495
test doc (Position 2 8) "foo" Nothing [expected]
489-
, testSession "local empty doc" $ do
496+
, testSessionEmpty "local empty doc" $ do
490497
doc <- createDoc "A.hs" "haskell" $ T.unlines
491498
[ "module A where"
492499
, "foo = ()"
493500
, "bar = fo"
494501
]
495502
test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"]
496-
, testSession "local single line doc without newline" $ do
503+
, testSessionEmpty "local single line doc without newline" $ do
497504
doc <- createDoc "A.hs" "haskell" $ T.unlines
498505
[ "module A where"
499506
, "-- |docdoc"
500507
, "foo = ()"
501508
, "bar = fo"
502509
]
503510
test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"]
504-
, testSession "local multi line doc with newline" $ do
511+
, testSessionEmpty "local multi line doc with newline" $ do
505512
doc <- createDoc "A.hs" "haskell" $ T.unlines
506513
[ "module A where"
507514
, "-- | abcabc"
@@ -510,7 +517,7 @@ completionDocTests =
510517
, "bar = fo"
511518
]
512519
test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"]
513-
, testSession "local multi line doc without newline" $ do
520+
, testSessionEmpty "local multi line doc without newline" $ do
514521
doc <- createDoc "A.hs" "haskell" $ T.unlines
515522
[ "module A where"
516523
, "-- | abcabc"
@@ -520,28 +527,28 @@ completionDocTests =
520527
, "bar = fo"
521528
]
522529
test doc (Position 5 8) "foo" Nothing ["*Defined at line 5, column 1 in this module*\n* * *\n\n\nabcabc \n\ndef\n"]
523-
, testSession "extern empty doc" $ do
530+
, testSessionEmpty "extern empty doc" $ do
524531
doc <- createDoc "A.hs" "haskell" $ T.unlines
525532
[ "module A where"
526533
, "foo = od"
527534
]
528535
let expected = "*Imported from 'Prelude'*\n"
529536
test doc (Position 1 8) "odd" (Just $ T.length expected) [expected]
530-
, brokenForMacGhc9 $ testSession "extern single line doc without '\\n'" $ do
537+
, testSessionEmpty "extern single line doc without '\\n'" $ do
531538
doc <- createDoc "A.hs" "haskell" $ T.unlines
532539
[ "module A where"
533540
, "foo = no"
534541
]
535542
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nBoolean \"not\"\n"
536543
test doc (Position 1 8) "not" (Just $ T.length expected) [expected]
537-
, brokenForMacGhc9 $ testSession "extern mulit line doc" $ do
544+
, testSessionEmpty "extern mulit line doc" $ do
538545
doc <- createDoc "A.hs" "haskell" $ T.unlines
539546
[ "module A where"
540547
, "foo = i"
541548
]
542549
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nIdentity function. \n```haskell\nid x = x\n```\n"
543550
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
544-
, testSession "extern defined doc" $ do
551+
, testSessionEmpty "extern defined doc" $ do
545552
doc <- createDoc "A.hs" "haskell" $ T.unlines
546553
[ "module A where"
547554
, "foo = i"
@@ -550,8 +557,6 @@ completionDocTests =
550557
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
551558
]
552559
where
553-
-- https://gitlab.haskell.org/ghc/ghc/-/issues/20903
554-
brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9"
555560
test doc pos label mn expected = do
556561
_ <- waitForDiagnostics
557562
compls <- getCompletions doc pos

0 commit comments

Comments
 (0)