Skip to content

Commit

Permalink
[Migrate CompletionTests] part of 4173 Migrate ghcide tests to hls te…
Browse files Browse the repository at this point in the history 
…st utils (haskell#4192)

* migrate ghcide-tests CompletionTests to hls-test-utils

* cleanup
  • Loading branch information
@soulomoon
soulomoon authored Apr 26, 2024
1 parent 8ef854a commit 8afc65a
Showing 1 changed file with 47 additions and 42 deletions.
89 changes: 47 additions & 42 deletions ghcide/test/exe/CompletionTests.hs
View file
Original file line number Diff line number Diff line change
@@ -1,9 +1,13 @@

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module CompletionTests (tests) where

import Config
import Control.Lens ((^.))
import qualified Control.Lens as Lens
import Control.Monad
Expand All @@ -14,7 +18,6 @@ import Data.Maybe
import Data.Row
import qualified Data.Text as T
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
import Development.IDE.Test (waitForTypecheck)
import Development.IDE.Types.Location
import Ide.Plugin.Config
import qualified Language.LSP.Protocol.Lens as L
Expand All @@ -25,10 +28,12 @@ import Language.LSP.Protocol.Types hiding
SemanticTokensEdit (..),
mkRange)
import Language.LSP.Test
import System.FilePath
import Test.Hls (waitForTypecheck)
import qualified Test.Hls.FileSystem as FS
import Test.Hls.FileSystem (file, text)
import Test.Hls.Util (knownBrokenOnWindows)
import Test.Tasty
import Test.Tasty.HUnit
import TestUtils


tests :: TestTree
Expand All @@ -44,9 +49,19 @@ tests
, testGroup "doc" completionDocTests
]

testSessionEmpty :: TestName -> Session () -> TestTree
testSessionEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]])

testSessionEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree
testSessionEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)])

testSessionSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree
testSessionSingleFile testName fp txt session =
testWithDummyPlugin testName (mkIdeTestFs [FS.directCradle [T.pack fp] , file fp (text txt)]) session

completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, CompletionItemKind, T.Text, Bool, Bool, Maybe [TextEdit])] -> TestTree
completionTest name src pos expected = testSessionWait name $ do
docId <- createDoc "A.hs" "haskell" (T.unlines src)
completionTest name src pos expected = testSessionSingleFile name "A.hs" (T.unlines src) $ do
docId <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getAndResolveCompletions docId pos
let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls]
Expand Down Expand Up @@ -185,7 +200,7 @@ localCompletionTests = [
[("abcd", CompletionItemKind_Function, "abcd", True, False, Nothing)
,("abcde", CompletionItemKind_Function, "abcde", True, False, Nothing)
],
testSessionWait "incomplete entries" $ do
testSessionEmpty "incomplete entries" $ do
let src a = "data Data = " <> a
doc <- createDoc "A.hs" "haskell" $ src "AAA"
void $ waitForTypecheck doc
Expand Down Expand Up @@ -261,7 +276,7 @@ nonLocalCompletionTests =
[]
]
where
brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC92, GHC94, GHC96, GHC98]) "Windows has strange things in scope for some reason"
brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason"

otherCompletionTests :: [TestTree]
otherCompletionTests = [
Expand All @@ -283,7 +298,7 @@ otherCompletionTests = [
(Position 3 11)
[("Integer", CompletionItemKind_Struct, "Integer", True, True, Nothing)],

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

testSessionWait "maxCompletions" $ do
testSessionEmpty "maxCompletions" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
"module A () where",
"a = Prelude."
]
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 3 13)
compls <- getCompletions doc (Position 3 13)
liftIO $ length compls @?= maxCompletions def
]

packageCompletionTests :: [TestTree]
packageCompletionTests =
[ testSession' "fromList" $ \dir -> do
liftIO $ writeFile (dir </> "hie.yaml")
"cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}"
[ testSessionEmptyWithCradle "fromList" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" $ do

doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
"module A () where",
Expand All @@ -337,9 +351,9 @@ packageCompletionTests =
map ("Defined in "<>) (
[ "'Data.List.NonEmpty"
, "'GHC.Exts"
] ++ if ghcVersion >= GHC94 then [ "'GHC.IsList" ] else [])
] ++ (["'GHC.IsList" | ghcVersion >= GHC94]))

, testSessionWait "Map" $ do
, testSessionEmpty "Map" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
"module A () where",
Expand All @@ -359,7 +373,7 @@ packageCompletionTests =
, "'Data.Map.Lazy"
, "'Data.Map.Strict"
]
, testSessionWait "no duplicates" $ do
, testSessionEmpty "no duplicates" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}",
"module A () where",
Expand All @@ -381,7 +395,7 @@ packageCompletionTests =
) compls
liftIO $ length duplicate @?= 1

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

projectCompletionTests :: [TestTree]
projectCompletionTests =
[ testSession' "from hiedb" $ \dir-> do
liftIO $ writeFile (dir </> "hie.yaml")
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
[ testSessionEmptyWithCradle "from hiedb" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
_ <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A (anidentifier) where",
"anidentifier = ()"
Expand All @@ -423,9 +435,7 @@ projectCompletionTests =
, _label == "anidentifier"
]
liftIO $ compls' @?= ["Defined in 'A"],
testSession' "auto complete project imports" $ \dir-> do
liftIO $ writeFile (dir </> "hie.yaml")
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}"
testSessionEmptyWithCradle "auto complete project imports" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" $ do
_ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines
[ "module ALocalModule (anidentifier) where",
"anidentifier = ()"
Expand All @@ -440,9 +450,7 @@ projectCompletionTests =
let item = head $ filter ((== "ALocalModule") . (^. L.label)) compls
liftIO $ do
item ^. L.label @?= "ALocalModule",
testSession' "auto complete functions from qualified imports without alias" $ \dir-> do
liftIO $ writeFile (dir </> "hie.yaml")
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
testSessionEmptyWithCradle "auto complete functions from qualified imports without alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
_ <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A (anidentifier) where",
"anidentifier = ()"
Expand All @@ -457,9 +465,8 @@ projectCompletionTests =
let item = head compls
liftIO $ do
item ^. L.label @?= "anidentifier",
testSession' "auto complete functions from qualified imports with alias" $ \dir-> do
liftIO $ writeFile (dir </> "hie.yaml")
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
testSessionEmptyWithCradle "auto complete functions from qualified imports with alias"
"cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do
_ <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A (anidentifier) where",
"anidentifier = ()"
Expand All @@ -478,30 +485,30 @@ projectCompletionTests =

completionDocTests :: [TestTree]
completionDocTests =
[ testSession "local define" $ do
[ testSessionEmpty "local define" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = ()"
, "bar = fo"
]
let expected = "*Defined at line 2, column 1 in this module*\n"
test doc (Position 2 8) "foo" Nothing [expected]
, testSession "local empty doc" $ do
, testSessionEmpty "local empty doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = ()"
, "bar = fo"
]
test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"]
, testSession "local single line doc without newline" $ do
, testSessionEmpty "local single line doc without newline" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "-- |docdoc"
, "foo = ()"
, "bar = fo"
]
test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"]
, testSession "local multi line doc with newline" $ do
, testSessionEmpty "local multi line doc with newline" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "-- | abcabc"
Expand All @@ -510,7 +517,7 @@ completionDocTests =
, "bar = fo"
]
test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"]
, testSession "local multi line doc without newline" $ do
, testSessionEmpty "local multi line doc without newline" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "-- | abcabc"
Expand All @@ -520,28 +527,28 @@ completionDocTests =
, "bar = fo"
]
test doc (Position 5 8) "foo" Nothing ["*Defined at line 5, column 1 in this module*\n* * *\n\n\nabcabc \n\ndef\n"]
, testSession "extern empty doc" $ do
, testSessionEmpty "extern empty doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = od"
]
let expected = "*Imported from 'Prelude'*\n"
test doc (Position 1 8) "odd" (Just $ T.length expected) [expected]
, brokenForMacGhc9 $ testSession "extern single line doc without '\\n'" $ do
, testSessionEmpty "extern single line doc without '\\n'" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = no"
]
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nBoolean \"not\"\n"
test doc (Position 1 8) "not" (Just $ T.length expected) [expected]
, brokenForMacGhc9 $ testSession "extern mulit line doc" $ do
, testSessionEmpty "extern mulit line doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = i"
]
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nIdentity function. \n```haskell\nid x = x\n```\n"
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
, testSession "extern defined doc" $ do
, testSessionEmpty "extern defined doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = i"
Expand All @@ -550,8 +557,6 @@ completionDocTests =
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
]
where
-- https://gitlab.haskell.org/ghc/ghc/-/issues/20903
brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9"
test doc pos label mn expected = do
_ <- waitForDiagnostics
compls <- getCompletions doc pos
Expand Down

0 comments on commit 8afc65a

Please sign in to comment.