diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index afa224f640..f94ed27de1 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -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 + , 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 diff --git a/test/testdata/gototest/Setup.hs b/test/testdata/gototest/Setup.hs deleted file mode 100644 index 9a994af677..0000000000 --- a/test/testdata/gototest/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/test/testdata/gototest/app/Main.hs b/test/testdata/gototest/app/Main.hs deleted file mode 100644 index 2c951ca59d..0000000000 --- a/test/testdata/gototest/app/Main.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main where - -import Lib -import Lib2 - -main :: IO () -main = someFunc >> g diff --git a/test/testdata/gototest/cabal.project b/test/testdata/gototest/cabal.project deleted file mode 100644 index 258ca2fe22..0000000000 --- a/test/testdata/gototest/cabal.project +++ /dev/null @@ -1,3 +0,0 @@ -packages: . - -write-ghc-environment-files: never diff --git a/test/testdata/gototest/gototest.cabal b/test/testdata/gototest/gototest.cabal deleted file mode 100644 index 5cac1ffefd..0000000000 --- a/test/testdata/gototest/gototest.cabal +++ /dev/null @@ -1,24 +0,0 @@ -name: gototest -version: 0.1.0.0 --- synopsis: --- description: -license: BSD3 -author: Author name here -maintainer: example@example.com -copyright: 2017 Author name here -category: Web -build-type: Simple -cabal-version: >=1.10 - -executable gototest-exec - hs-source-dirs: app - main-is: Main.hs - other-modules: - build-depends: base >= 4.7 && < 5, gototest - default-language: Haskell2010 - -library - hs-source-dirs: src - exposed-modules: Lib, Lib2 - build-depends: base >= 4.7 && < 5 - default-language: Haskell2010 diff --git a/test/testdata/gototest/hie.yaml b/test/testdata/gototest/hie.yaml new file mode 100644 index 0000000000..94c8271c18 --- /dev/null +++ b/test/testdata/gototest/hie.yaml @@ -0,0 +1,6 @@ +cradle: + direct: + arguments: + - "-i src/" + - "Lib" + - "Lib2" diff --git a/test/testdata/gototest/src/Lib.hs b/test/testdata/gototest/src/Lib.hs index 2603a7474c..5698c76832 100644 --- a/test/testdata/gototest/src/Lib.hs +++ b/test/testdata/gototest/src/Lib.hs @@ -37,4 +37,4 @@ typEnuId enu = enu data Parameter a = Parameter a parameterId :: Parameter a -> Parameter a -parameterId pid = pid \ No newline at end of file +parameterId pid = pid