Skip to content

Commit 175c295

Browse files
soulomoonsoulomoon
committed
move completion test to haskell core
1 parent 11c1eb9 commit 175c295

File tree

6 files changed

+91
-41
lines changed

6 files changed

+91
-41
lines changed

‎ghcide/ghcide.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -371,7 +371,6 @@ test-suite ghcide-tests
371371
BootTests
372372
ClientSettingsTests
373373
CodeLensTests
374-
CompletionTests
375374
CPPTests
376375
CradleTests
377376
DependentFileTest

‎ghcide/test/exe/Main.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,6 @@ import Test.Tasty.Ingredients.Rerun
4747

4848
import LogType ()
4949
import OpenCloseTest
50-
import CompletionTests
5150
import CPPTests
5251
import DiagnosticTests
5352
import CodeLensTests
@@ -91,7 +90,6 @@ main = do
9190
-- We mess with env vars so run single-threaded.
9291
defaultMainWithRerun $ testGroup "ghcide"
9392
[ OpenCloseTest.tests
94-
, CompletionTests.tests
9593
, CPPTests.tests
9694
, DiagnosticTests.tests
9795
, CodeLensTests.tests

‎haskell-language-server.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1659,9 +1659,10 @@ test-suite hls-core-plugin-tests
16591659
, plugins/hls-core-plugin/test/exe
16601660
main-is: CoreTest.hs
16611661
other-modules:
1662+
Util
16621663
InitializeResponseTests
16631664
OutlineTests
1664-
Util
1665+
CompletionTests
16651666

16661667

16671668
build-depends:

‎plugins/hls-core-plugin/test/CoreTest.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE OverloadedLabels #-}
33
{-# LANGUAGE OverloadedStrings #-}
44

5+
import qualified CompletionTests
56
import qualified InitializeResponseTests
67
import qualified OutlineTests
78
import Test.Hls (defaultTestRunner, testGroup)
@@ -14,4 +15,5 @@ main =
1415
"core"
1516
[ InitializeResponseTests.tests
1617
, OutlineTests.tests
18+
, CompletionTests.tests
1719
]

‎ghcide/test/exe/CompletionTests.hs renamed to ‎plugins/hls-core-plugin/test/exe/CompletionTests.hs

Lines changed: 40 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,9 @@
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

@@ -14,7 +17,6 @@ import Data.Maybe
1417
import Data.Row
1518
import qualified Data.Text as T
1619
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
17-
import Development.IDE.Test (waitForTypecheck)
1820
import Development.IDE.Types.Location
1921
import Ide.Plugin.Config
2022
import qualified Language.LSP.Protocol.Lens as L
@@ -26,9 +28,12 @@ import Language.LSP.Protocol.Types hiding
2628
mkRange)
2729
import Language.LSP.Test
2830
import System.FilePath
31+
import Test.Hls (waitForTypecheck)
32+
import qualified Test.Hls.FileSystem as FS
33+
import Test.Hls.FileSystem (file, text)
2934
import Test.Tasty
3035
import Test.Tasty.HUnit
31-
import TestUtils
36+
import Util
3237

3338

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

52+
testSessionWithCorePluginEmpty :: TestName -> Session () -> TestTree
53+
testSessionWithCorePluginEmpty name = testCase name . runSessionWithCorePluginEmpty ["A.hs"]
54+
55+
testSessionWithCorePluginEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree
56+
testSessionWithCorePluginEmptyWithCradle name cradle = testCase name . runSessionWithCorePlugin (mkFs [file "hie.yaml" (text cradle)])
57+
4758
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)
59+
completionTest name src pos expected = testSessionWithCorePluginSingleFile name "A.hs" (T.unlines src) $ do
60+
docId <- openDoc "A.hs" "haskell"
5061
_ <- waitForDiagnostics
5162
compls <- getAndResolveCompletions docId pos
5263
let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls]
@@ -185,7 +196,7 @@ localCompletionTests = [
185196
[("abcd", CompletionItemKind_Function, "abcd", True, False, Nothing)
186197
,("abcde", CompletionItemKind_Function, "abcde", True, False, Nothing)
187198
],
188-
testSessionWait "incomplete entries" $ do
199+
testSessionWithCorePluginEmpty "incomplete entries" $ do
189200
let src a = "data Data = " <> a
190201
doc <- createDoc "A.hs" "haskell" $ src "AAA"
191202
void $ waitForTypecheck doc
@@ -283,7 +294,7 @@ otherCompletionTests = [
283294
(Position 3 11)
284295
[("Integer", CompletionItemKind_Struct, "Integer", True, True, Nothing)],
285296

286-
testSession "duplicate record fields" $ do
297+
testSessionWithCorePluginEmpty "duplicate record fields" $ do
287298
void $
288299
createDoc "B.hs" "haskell" $
289300
T.unlines
@@ -304,22 +315,21 @@ otherCompletionTests = [
304315
let compls' = [txt | CompletionItem {_insertText = Just txt, ..} <- compls, _label == "member"]
305316
liftIO $ take 1 compls' @?= ["member"],
306317

307-
testSessionWait "maxCompletions" $ do
318+
testSessionWithCorePluginEmpty "maxCompletions" $ do
308319
doc <- createDoc "A.hs" "haskell" $ T.unlines
309320
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
310321
"module A () where",
311322
"a = Prelude."
312323
]
313324
_ <- waitForDiagnostics
314-
compls <- getCompletions doc (Position 3 13)
325+
compls <- getCompletions doc (Position 3 13)
315326
liftIO $ length compls @?= maxCompletions def
316327
]
317328

318329
packageCompletionTests :: [TestTree]
319330
packageCompletionTests =
320-
[ testSession' "fromList" $ \dir -> do
321-
liftIO $ writeFile (dir </> "hie.yaml")
322-
"cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}"
331+
[ testSessionWithCorePluginEmptyWithCradle "fromList" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" $ do
332+
323333
doc <- createDoc "A.hs" "haskell" $ T.unlines
324334
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
325335
"module A () where",
@@ -339,7 +349,7 @@ packageCompletionTests =
339349
, "'GHC.Exts"
340350
] ++ if ghcVersion >= GHC94 then [ "'GHC.IsList" ] else [])
341351

342-
, testSessionWait "Map" $ do
352+
, testSessionWithCorePluginEmpty "Map" $ do
343353
doc <- createDoc "A.hs" "haskell" $ T.unlines
344354
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
345355
"module A () where",
@@ -359,7 +369,7 @@ packageCompletionTests =
359369
, "'Data.Map.Lazy"
360370
, "'Data.Map.Strict"
361371
]
362-
, testSessionWait "no duplicates" $ do
372+
, testSessionWithCorePluginEmpty "no duplicates" $ do
363373
doc <- createDoc "A.hs" "haskell" $ T.unlines
364374
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
365375
"module A () where",
@@ -381,7 +391,7 @@ packageCompletionTests =
381391
) compls
382392
liftIO $ length duplicate @?= 1
383393

384-
, testSessionWait "non-local before global" $ do
394+
, testSessionWithCorePluginEmpty "non-local before global" $ do
385395
-- non local completions are more specific
386396
doc <- createDoc "A.hs" "haskell" $ T.unlines
387397
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
@@ -402,9 +412,7 @@ packageCompletionTests =
402412

403413
projectCompletionTests :: [TestTree]
404414
projectCompletionTests =
405-
[ testSession' "from hiedb" $ \dir-> do
406-
liftIO $ writeFile (dir </> "hie.yaml")
407-
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
415+
[ testSessionWithCorePluginEmptyWithCradle "from hiedb" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
408416
_ <- createDoc "A.hs" "haskell" $ T.unlines
409417
[ "module A (anidentifier) where",
410418
"anidentifier = ()"
@@ -423,9 +431,7 @@ projectCompletionTests =
423431
, _label == "anidentifier"
424432
]
425433
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\"]}}"
434+
testSessionWithCorePluginEmptyWithCradle "auto complete project imports" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" $ do
429435
_ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines
430436
[ "module ALocalModule (anidentifier) where",
431437
"anidentifier = ()"
@@ -440,9 +446,7 @@ projectCompletionTests =
440446
let item = head $ filter ((== "ALocalModule") . (^. L.label)) compls
441447
liftIO $ do
442448
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\"]}}"
449+
testSessionWithCorePluginEmptyWithCradle "auto complete functions from qualified imports without alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
446450
_ <- createDoc "A.hs" "haskell" $ T.unlines
447451
[ "module A (anidentifier) where",
448452
"anidentifier = ()"
@@ -457,9 +461,8 @@ projectCompletionTests =
457461
let item = head compls
458462
liftIO $ do
459463
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\"]}}"
464+
testSessionWithCorePluginEmptyWithCradle "auto complete functions from qualified imports with alias"
465+
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
463466
_ <- createDoc "A.hs" "haskell" $ T.unlines
464467
[ "module A (anidentifier) where",
465468
"anidentifier = ()"
@@ -478,30 +481,30 @@ projectCompletionTests =
478481

479482
completionDocTests :: [TestTree]
480483
completionDocTests =
481-
[ testSession "local define" $ do
484+
[ testSessionWithCorePluginEmpty "local define" $ do
482485
doc <- createDoc "A.hs" "haskell" $ T.unlines
483486
[ "module A where"
484487
, "foo = ()"
485488
, "bar = fo"
486489
]
487490
let expected = "*Defined at line 2, column 1 in this module*\n"
488491
test doc (Position 2 8) "foo" Nothing [expected]
489-
, testSession "local empty doc" $ do
492+
, testSessionWithCorePluginEmpty "local empty doc" $ do
490493
doc <- createDoc "A.hs" "haskell" $ T.unlines
491494
[ "module A where"
492495
, "foo = ()"
493496
, "bar = fo"
494497
]
495498
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
499+
, testSessionWithCorePluginEmpty "local single line doc without newline" $ do
497500
doc <- createDoc "A.hs" "haskell" $ T.unlines
498501
[ "module A where"
499502
, "-- |docdoc"
500503
, "foo = ()"
501504
, "bar = fo"
502505
]
503506
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
507+
, testSessionWithCorePluginEmpty "local multi line doc with newline" $ do
505508
doc <- createDoc "A.hs" "haskell" $ T.unlines
506509
[ "module A where"
507510
, "-- | abcabc"
@@ -510,7 +513,7 @@ completionDocTests =
510513
, "bar = fo"
511514
]
512515
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
516+
, testSessionWithCorePluginEmpty "local multi line doc without newline" $ do
514517
doc <- createDoc "A.hs" "haskell" $ T.unlines
515518
[ "module A where"
516519
, "-- | abcabc"
@@ -520,28 +523,28 @@ completionDocTests =
520523
, "bar = fo"
521524
]
522525
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
526+
, testSessionWithCorePluginEmpty "extern empty doc" $ do
524527
doc <- createDoc "A.hs" "haskell" $ T.unlines
525528
[ "module A where"
526529
, "foo = od"
527530
]
528531
let expected = "*Imported from 'Prelude'*\n"
529532
test doc (Position 1 8) "odd" (Just $ T.length expected) [expected]
530-
, brokenForMacGhc9 $ testSession "extern single line doc without '\\n'" $ do
533+
, brokenForMacGhc9 $ testSessionWithCorePluginEmpty "extern single line doc without '\\n'" $ do
531534
doc <- createDoc "A.hs" "haskell" $ T.unlines
532535
[ "module A where"
533536
, "foo = no"
534537
]
535538
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nBoolean \"not\"\n"
536539
test doc (Position 1 8) "not" (Just $ T.length expected) [expected]
537-
, brokenForMacGhc9 $ testSession "extern mulit line doc" $ do
540+
, brokenForMacGhc9 $ testSessionWithCorePluginEmpty "extern mulit line doc" $ do
538541
doc <- createDoc "A.hs" "haskell" $ T.unlines
539542
[ "module A where"
540543
, "foo = i"
541544
]
542545
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nIdentity function. \n```haskell\nid x = x\n```\n"
543546
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
544-
, testSession "extern defined doc" $ do
547+
, testSessionWithCorePluginEmpty "extern defined doc" $ do
545548
doc <- createDoc "A.hs" "haskell" $ T.unlines
546549
[ "module A where"
547550
, "foo = i"

‎plugins/hls-core-plugin/test/exe/Util.hs

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,18 @@
1+
{-# LANGUAGE LambdaCase #-}
12
{-# LANGUAGE OverloadedStrings #-}
23

34
module Util where
45

56
import Data.Default (Default (..))
67
import Data.Text (Text)
78
import qualified Data.Text as Text
9+
import Development.IDE (GhcVersion, ghcVersion)
810
import qualified Ide.Plugin.Core as Core
911
import Language.LSP.Test (Session)
1012
import System.FilePath ((</>))
13+
import System.Info.Extra
1114
import Test.Hls (PluginTestDescriptor, TestName, TestTree,
15+
expectFailBecause, ignoreTestBecause,
1216
mkPluginTestDescriptor,
1317
runSessionWithServerInTmpDir, testCase)
1418
import qualified Test.Hls.FileSystem as FS
@@ -18,6 +22,9 @@ import Test.Hls.FileSystem (file, text)
1822
runSessionWithCorePlugin :: FS.VirtualFileTree -> Session a -> IO a
1923
runSessionWithCorePlugin = runSessionWithServerInTmpDir def corePlugin
2024

25+
runSessionWithCorePluginEmpty :: [Text] -> Session a -> IO a
26+
runSessionWithCorePluginEmpty fps = runSessionWithCorePlugin (mkFs [FS.directCradle fps])
27+
2128
runSessionWithCorePluginSingleFile :: FilePath -> Text -> Session a -> IO a
2229
runSessionWithCorePluginSingleFile fp content = runSessionWithCorePlugin (mkSingleFileFs fp content)
2330

@@ -41,3 +48,43 @@ mkFs = FS.mkVirtualFileTree testDataDir
4148

4249
testDataDir :: FilePath
4350
testDataDir = "plugins" </> "core-plugin" </> "test" </> "testdata"
51+
52+
53+
data BrokenOS = Linux | MacOS | Windows deriving (Show)
54+
55+
data IssueSolution = Broken | Ignore deriving (Show)
56+
57+
data BrokenTarget =
58+
BrokenSpecific BrokenOS [GhcVersion]
59+
-- ^Broken for `BrokenOS` with `GhcVersion`
60+
| BrokenForOS BrokenOS
61+
-- ^Broken for `BrokenOS`
62+
| BrokenForGHC [GhcVersion]
63+
-- ^Broken for `GhcVersion`
64+
deriving (Show)
65+
66+
ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree
67+
ignoreFor = knownIssueFor Ignore
68+
69+
-- | Known broken for specific os and ghc with reason.
70+
knownBrokenFor :: BrokenTarget -> String -> TestTree -> TestTree
71+
knownBrokenFor = knownIssueFor Broken
72+
73+
-- | Deal with `IssueSolution` for specific OS and GHC.
74+
knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree
75+
knownIssueFor solution = go . \case
76+
BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers
77+
BrokenForOS bos -> isTargetOS bos
78+
BrokenForGHC vers -> isTargetGhc vers
79+
where
80+
isTargetOS = \case
81+
Windows -> isWindows
82+
MacOS -> isMac
83+
Linux -> not isWindows && not isMac
84+
85+
isTargetGhc = elem ghcVersion
86+
87+
go True = case solution of
88+
Broken -> expectFailBecause
89+
Ignore -> ignoreTestBecause
90+
go False = const id

0 commit comments

Comments
 (0)