Skip to content

Commit 0c7e9a0

Browse files
jneirajneira
authored
Merge pull request #690 from peterwicksstringfield/enable_get_type_definition_tests
Enable get type definition tests
2 parents 0063ec7 + 32b5cbc commit 0c7e9a0

File tree

7 files changed

+44
-122
lines changed

7 files changed

+44
-122
lines changed

‎test/functional/TypeDefinition.hs‎

Lines changed: 37 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -1,102 +1,54 @@
11
module TypeDefinition (tests) where
22

3+
import Control.Lens ((^.))
34
import Control.Monad.IO.Class
45
import Language.Haskell.LSP.Test
56
import Language.Haskell.LSP.Types
7+
import qualified Language.Haskell.LSP.Types.Lens as L
68
import System.Directory
9+
import System.FilePath ((</>))
710
import Test.Hls.Util
811
import Test.Tasty
9-
import Test.Tasty.ExpectedFailure (ignoreTestBecause)
1012
import Test.Tasty.HUnit
1113

1214
tests :: TestTree
1315
tests = testGroup "type definitions" [
14-
ignoreTestBecause "Broken" $ testCase "finds local definition of record variable"
15-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
16-
$ do
17-
doc <- openDoc "src/Lib.hs" "haskell"
18-
defs <- getTypeDefinitions doc (toPos (11, 23))
19-
liftIO $ do
20-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
21-
defs @?= [ Location (filePathToUri fp)
22-
(Range (toPos (8, 1)) (toPos (8, 29)))
23-
]
24-
, ignoreTestBecause "Broken" $ testCase "finds local definition of newtype variable"
25-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
26-
$ do
27-
doc <- openDoc "src/Lib.hs" "haskell"
28-
defs <- getTypeDefinitions doc (toPos (16, 21))
29-
liftIO $ do
30-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
31-
defs @?= [ Location (filePathToUri fp)
32-
(Range (toPos (13, 1)) (toPos (13, 30)))
33-
]
34-
, ignoreTestBecause "Broken" $ testCase "finds local definition of sum type variable"
35-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
36-
$ do
37-
doc <- openDoc "src/Lib.hs" "haskell"
38-
defs <- getTypeDefinitions doc (toPos (21, 13))
39-
liftIO $ do
40-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
41-
defs @?= [ Location (filePathToUri fp)
42-
(Range (toPos (18, 1)) (toPos (18, 26)))
43-
]
44-
, ignoreTestBecause "Broken" $ testCase "finds local definition of sum type contructor"
45-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
46-
$ do
47-
doc <- openDoc "src/Lib.hs" "haskell"
48-
defs <- getTypeDefinitions doc (toPos (24, 7))
49-
liftIO $ do
50-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
51-
defs
52-
@?= [ Location (filePathToUri fp)
53-
(Range (toPos (18, 1)) (toPos (18, 26)))
54-
]
55-
, ignoreTestBecause "Broken" $ testCase "can not find non-local definition of type def"
56-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
57-
$ do
58-
doc <- openDoc "src/Lib.hs" "haskell"
59-
defs <- getTypeDefinitions doc (toPos (30, 17))
60-
liftIO $ defs @?= []
16+
testCase "finds local definition of record variable"
17+
$ getTypeDefinitionTest' (11, 23) 8
18+
, testCase "finds local definition of newtype variable"
19+
$ getTypeDefinitionTest' (16, 21) 13
20+
, testCase "finds local definition of sum type variable"
21+
$ getTypeDefinitionTest' (21, 13) 18
22+
, knownBrokenForGhcVersions [GHC88] "Definition of sum type not found from data constructor in GHC 8.8.x" $
23+
testCase "finds local definition of sum type constructor"
24+
$ getTypeDefinitionTest' (24, 7) 18
25+
, testCase "finds non-local definition of type def"
26+
$ getTypeDefinitionTest' (30, 17) 27
27+
, testCase "find local definition of type def"
28+
$ getTypeDefinitionTest' (35, 16) 32
29+
, testCase "find type-definition of type def in component"
30+
$ getTypeDefinitionTest "src/Lib2.hs" (13, 20) "src/Lib.hs" 8
31+
, testCase "find definition of parameterized data type"
32+
$ getTypeDefinitionTest' (40, 19) 37
33+
]
6134

62-
, ignoreTestBecause "Broken" $ testCase "find local definition of type def"
63-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
64-
$ do
65-
doc <- openDoc "src/Lib.hs" "haskell"
66-
defs <- getTypeDefinitions doc (toPos (35, 16))
67-
liftIO $ do
68-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
69-
defs @?= [ Location (filePathToUri fp)
70-
(Range (toPos (18, 1)) (toPos (18, 26)))
71-
]
35+
getTypeDefinitionTest :: String -> (Int, Int) -> String -> Int -> Assertion
36+
getTypeDefinitionTest symbolFile symbolPosition definitionFile definitionLine =
37+
failIfSessionTimeout . runSession hlsCommand fullCaps "test/testdata/gototest" $ do
38+
doc <- openDoc symbolFile "haskell"
39+
_ <- openDoc definitionFile "haskell"
40+
defs <- getTypeDefinitions doc $ toPos symbolPosition
41+
fp <- liftIO $ canonicalizePath $ "test/testdata/gototest" </> definitionFile
42+
liftIO $ do
43+
length defs == 1 @? "Expecting a list containing one location, but got: " ++ show defs
44+
let [def] = defs
45+
def ^. L.uri @?= filePathToUri fp
46+
def ^. L.range . L.start . L.line @?= definitionLine - 1
47+
def ^. L.range . L.end . L.line @?= definitionLine - 1
7248

73-
{-- TODO Implement
74-
, ignoreTestBecause "Broken" $ testCase "find type-definition of type def in component"
75-
$ pendingWith "Finding symbols cross module is currently not supported"
76-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
77-
$ do
78-
doc <- openDoc "src/Lib2.hs" "haskell"
79-
otherDoc <- openDoc "src/Lib.hs" "haskell"
80-
closeDoc otherDoc
81-
defs <- getTypeDefinitions doc (toPos (13, 20))
82-
liftIO $ do
83-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
84-
defs
85-
@?= [ Location (filePathToUri fp)
86-
(Range (toPos (8, 1)) (toPos (8, 29)))
87-
]
88-
--}
89-
, ignoreTestBecause "Broken" $ testCase "find definition of parameterized data type"
90-
$ runSession hlsCommand fullCaps "test/testdata/gototest"
91-
$ do
92-
doc <- openDoc "src/Lib.hs" "haskell"
93-
defs <- getTypeDefinitions doc (toPos (40, 19))
94-
liftIO $ do
95-
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
96-
defs @?= [ Location (filePathToUri fp)
97-
(Range (toPos (37, 1)) (toPos (37, 31)))
98-
]
99-
]
49+
getTypeDefinitionTest' :: (Int, Int) -> Int -> Assertion
50+
getTypeDefinitionTest' symbolPosition definitionLine =
51+
getTypeDefinitionTest "src/Lib.hs" symbolPosition "src/Lib.hs" definitionLine
10052

10153
--NOTE: copied from Haskell.Ide.Engine.ArtifactMap
10254
toPos :: (Int,Int) -> Position

‎test/testdata/gototest/Setup.hs‎

Lines changed: 0 additions & 2 deletions
This file was deleted.

‎test/testdata/gototest/app/Main.hs‎

Lines changed: 0 additions & 7 deletions
This file was deleted.

‎test/testdata/gototest/cabal.project‎

Lines changed: 0 additions & 3 deletions
This file was deleted.

‎test/testdata/gototest/gototest.cabal‎

Lines changed: 0 additions & 24 deletions
This file was deleted.

‎test/testdata/gototest/hie.yaml‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
cradle:
2+
direct:
3+
arguments:
4+
- "-i src/"
5+
- "Lib"
6+
- "Lib2"

‎test/testdata/gototest/src/Lib.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,4 +37,4 @@ typEnuId enu = enu
3737
data Parameter a = Parameter a
3838

3939
parameterId :: Parameter a -> Parameter a
40-
parameterId pid = pid
40+
parameterId pid = pid

0 commit comments

Comments
 (0)