Skip to content

Enable get type definition tests #690

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Dec 22, 2020
Merged

Enable get type definition tests #690

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
cf3f6fa
Add final newline.
peterwicksstringfield Dec 20, 2020
5fc4966
Enable getTypeDefinitions tests.
peterwicksstringfield Dec 20, 2020
d067009
Refactor getTypeDefinition tests.
peterwicksstringfield Dec 20, 2020
a475307
Fix cradle and enable last getTypeDefinition test.
peterwicksstringfield Dec 20, 2020
32b5cbc
Disable test on GHC 8.8.x.
peterwicksstringfield Dec 21, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
122 changes: 37 additions & 85 deletions test/functional/TypeDefinition.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,102 +1,54 @@
module TypeDefinition (tests) where

import Control.Lens ((^.))
import Control.Monad.IO.Class
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types.Lens as L
import System.Directory
import System.FilePath ((</>))
import Test.Hls.Util
import Test.Tasty
import Test.Tasty.ExpectedFailure (ignoreTestBecause)
import Test.Tasty.HUnit

tests :: TestTree
tests = testGroup "type definitions" [
ignoreTestBecause "Broken" $ testCase "finds local definition of record variable"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (11, 23))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs @?= [ Location (filePathToUri fp)
(Range (toPos (8, 1)) (toPos (8, 29)))
]
, ignoreTestBecause "Broken" $ testCase "finds local definition of newtype variable"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (16, 21))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs @?= [ Location (filePathToUri fp)
(Range (toPos (13, 1)) (toPos (13, 30)))
]
, ignoreTestBecause "Broken" $ testCase "finds local definition of sum type variable"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (21, 13))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs @?= [ Location (filePathToUri fp)
(Range (toPos (18, 1)) (toPos (18, 26)))
]
, ignoreTestBecause "Broken" $ testCase "finds local definition of sum type contructor"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (24, 7))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs
@?= [ Location (filePathToUri fp)
(Range (toPos (18, 1)) (toPos (18, 26)))
]
, ignoreTestBecause "Broken" $ testCase "can not find non-local definition of type def"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (30, 17))
liftIO $ defs @?= []
testCase "finds local definition of record variable"
$ getTypeDefinitionTest' (11, 23) 8
, testCase "finds local definition of newtype variable"
$ getTypeDefinitionTest' (16, 21) 13
, testCase "finds local definition of sum type variable"
$ getTypeDefinitionTest' (21, 13) 18
, knownBrokenForGhcVersions [GHC88] "Definition of sum type not found from data constructor in GHC 8.8.x" $
testCase "finds local definition of sum type constructor"
$ getTypeDefinitionTest' (24, 7) 18
, testCase "finds non-local definition of type def"
$ getTypeDefinitionTest' (30, 17) 27
, testCase "find local definition of type def"
$ getTypeDefinitionTest' (35, 16) 32
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note: In the original test, the symbol who's type's definition we seek was at (35,16) and the type found was the data declaration for Enu at line 18 (data Enu = First | Second). Now we instead find a type definition for TypEnu at line 32 (type TypEnu = Enu).

The behavior of "Go to Type Definition" in this case:

data Enu = First | Second
type TypEnu = Enu
typEnuId :: TypEnu -> TypEnu
typEnuId enu = en[CURSOR HERE]u

seems to have changed. Formerly, we got the underlying type, now we get the type synonym. This is good though. Because in this case:

type MyInt = Int
myIntId :: MyInt -> MyInt
myIntId myInt = my[CURSOR HERE]Int

The new behavior will show us that MyInt is just an Int, while the old behavior would produce "No type definition found for myInt".

, testCase "find type-definition of type def in component"
$ getTypeDefinitionTest "src/Lib2.hs" (13, 20) "src/Lib.hs" 8
, testCase "find definition of parameterized data type"
$ getTypeDefinitionTest' (40, 19) 37
]

, ignoreTestBecause "Broken" $ testCase "find local definition of type def"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (35, 16))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs @?= [ Location (filePathToUri fp)
(Range (toPos (18, 1)) (toPos (18, 26)))
]
getTypeDefinitionTest :: String -> (Int, Int) -> String -> Int -> Assertion
getTypeDefinitionTest symbolFile symbolPosition definitionFile definitionLine =
failIfSessionTimeout . runSession hlsCommand fullCaps "test/testdata/gototest" $ do
doc <- openDoc symbolFile "haskell"
_ <- openDoc definitionFile "haskell"
defs <- getTypeDefinitions doc $ toPos symbolPosition
fp <- liftIO $ canonicalizePath $ "test/testdata/gototest" </> definitionFile
liftIO $ do
length defs == 1 @? "Expecting a list containing one location, but got: " ++ show defs
let [def] = defs
def ^. L.uri @?= filePathToUri fp
def ^. L.range . L.start . L.line @?= definitionLine - 1
def ^. L.range . L.end . L.line @?= definitionLine - 1

{-- TODO Implement
, ignoreTestBecause "Broken" $ testCase "find type-definition of type def in component"
$ pendingWith "Finding symbols cross module is currently not supported"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib2.hs" "haskell"
otherDoc <- openDoc "src/Lib.hs" "haskell"
closeDoc otherDoc
defs <- getTypeDefinitions doc (toPos (13, 20))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs
@?= [ Location (filePathToUri fp)
(Range (toPos (8, 1)) (toPos (8, 29)))
]
--}
, ignoreTestBecause "Broken" $ testCase "find definition of parameterized data type"
$ runSession hlsCommand fullCaps "test/testdata/gototest"
$ do
doc <- openDoc "src/Lib.hs" "haskell"
defs <- getTypeDefinitions doc (toPos (40, 19))
liftIO $ do
fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
defs @?= [ Location (filePathToUri fp)
(Range (toPos (37, 1)) (toPos (37, 31)))
]
]
getTypeDefinitionTest' :: (Int, Int) -> Int -> Assertion
getTypeDefinitionTest' symbolPosition definitionLine =
getTypeDefinitionTest "src/Lib.hs" symbolPosition "src/Lib.hs" definitionLine

--NOTE: copied from Haskell.Ide.Engine.ArtifactMap
toPos :: (Int,Int) -> Position
Expand Down
2 changes: 0 additions & 2 deletions test/testdata/gototest/Setup.hs
View file
Open in desktop

This file was deleted.

7 changes: 0 additions & 7 deletions test/testdata/gototest/app/Main.hs
View file
Open in desktop

This file was deleted.

3 changes: 0 additions & 3 deletions test/testdata/gototest/cabal.project
View file
Open in desktop

This file was deleted.

24 changes: 0 additions & 24 deletions test/testdata/gototest/gototest.cabal
View file
Open in desktop

This file was deleted.

6 changes: 6 additions & 0 deletions test/testdata/gototest/hie.yaml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
cradle:
direct:
arguments:
- "-i src/"
- "Lib"
- "Lib2"
2 changes: 1 addition & 1 deletion test/testdata/gototest/src/Lib.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,4 +37,4 @@ typEnuId enu = enu
data Parameter a = Parameter a

parameterId :: Parameter a -> Parameter a
parameterId pid = pid
parameterId pid = pid