From e35a426c212f34f30fa01a0c69cf2e1db9610a32 Mon Sep 17 00:00:00 2001 From: Christoph Hochrainer Date: Sun, 18 Aug 2024 01:23:29 +0200 Subject: [PATCH] add tests for cabal goto-definition --- plugins/hls-cabal-plugin/test/Main.hs | 55 ++++++++++++++++ .../goto-definition/simple-with-common.cabal | 62 +++++++++++++++++++ 2 files changed, 117 insertions(+) create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index ddc197c4ae..a3dce3e5ee 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -20,6 +20,7 @@ import qualified Data.Text as Text import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Types as LSP import Outline (outlineTests) import System.FilePath import Test.Hls @@ -36,6 +37,7 @@ main = do , contextTests , outlineTests , codeActionTests + , gotoDefinitionTests ] -- ------------------------------------------------------------------------ @@ -227,3 +229,56 @@ codeActionTests = testGroup "Code Actions" InR action@CodeAction{_title} <- codeActions guard (_title == "Replace with " <> license) pure action + +-- ---------------------------------------------------------------------------- +-- Goto Definition Tests +-- ---------------------------------------------------------------------------- + +gotoDefinitionTests :: TestTree +gotoDefinitionTests = testGroup "Goto Definition" + [ positiveTest "middle of identifier" (mkP 27 16) (mkR 6 0 7 22) + , positiveTest "left of identifier" (mkP 30 12) (mkR 10 0 17 40) + , positiveTest "right of identifier" (mkP 33 22) (mkR 20 0 23 34) + , positiveTest "left of '-' in identifier" (mkP 36 20) (mkR 6 0 7 22) + , positiveTest "right of '-' in identifier" (mkP 39 19) (mkR 10 0 17 40) + , positiveTest "identifier in identifier list" (mkP 42 16) (mkR 20 0 23 34) + , positiveTest "left of ',' right of identifier" (mkP 45 33) (mkR 10 0 17 40) + , positiveTest "right of ',' left of identifier" (mkP 48 34) (mkR 6 0 7 22) + + , negativeTest "right of ',' left of space" (mkP 51 23) + , negativeTest "right of ':' left of space" (mkP 54 11) + , negativeTest "not a definition" (mkP 57 8) + , negativeTest "empty space" (mkP 59 7) + ] + where + mkP :: UInt -> UInt -> Position + mkP x1 y1 = Position x1 y1 + + mkR :: UInt -> UInt -> UInt -> UInt -> Range + mkR x1 y1 x2 y2 = Range (mkP x1 y1) (mkP x2 y2) + + getDefinition :: Show b => (Definition |? b) -> Range + getDefinition (InL (Definition (InL loc))) = loc^.L.range + getDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" + + -- A positive tests checks if the provided range is equal + -- to the expected range from the definition in the test file. + -- The test emulates a goto-definition request of an actual definition. + positiveTest :: TestName -> Position -> Range -> TestTree + positiveTest testName cursorPos expectedRange = + runCabalTestCaseSession testName "goto-definition" $ do + doc <- openDoc "simple-with-common.cabal" "cabal" + definitions <- getDefinitions doc cursorPos + let locationRange = getDefinition definitions + liftIO $ locationRange @?= expectedRange + + -- A negative tests checks if the request failed and + -- the provided result is empty, i.e. `InR $ InR Null`. + -- The test emulates a goto-definition request of anything but an + -- actual definition. + negativeTest :: TestName -> Position -> TestTree + negativeTest testName cursorPos = + runCabalTestCaseSession testName "goto-definition" $ do + doc <- openDoc "simple-with-common.cabal" "cabal" + empty <- getDefinitions doc cursorPos + liftIO $ empty @?= (InR $ InR LSP.Null) diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal new file mode 100644 index 0000000000..c71e369b30 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal @@ -0,0 +1,62 @@ +cabal-version: 3.0 +name: simple-cabal +version: 0.1.0.0 +license: MIT + +-- Range : (6, 0) - (7, 22) +common warnings-0 + ghc-options: -Wall + +-- Range : (10, 0) - (17, 40) +common warnings-1 + ghc-options: -Wall + -Wredundant-constraints + -Wunused-packages + + -Wno-name-shadowing + + -Wno-unticked-promoted-constructors + +-- Range : (20, 0) - (23, 34) +common warnings-2 + ghc-options: -Wall + -Wredundant-constraints + -Wunused-packages + +library + + import: warnings-0 +-- ^ Position: (27, 16), middle of identifier + + import: warnings-1 +-- ^ Position: (30, 12), left of identifier + + import: warnings-2 +-- ^ Position: (33, 22), right of identifier + + import: warnings-0 +-- ^ Position: (36, 20), left of '-' in identifier + + import: warnings-1 +-- ^ Position: (39, 19), right of "-" in identifier + + import: warnings-2,warnings-1,warnings-0 +-- ^ Position: (42, 16), identifier in identifier list + + import: warnings-2,warnings-1,warnings-0 +-- ^ Position: (45, 33), left of ',' right of identifier + + import: warnings-2,warnings-1,warnings-0 +-- ^ Position: (48, 34), right of ',' left of identifier + + import: warnings-2, warnings-1,warnings-0 +-- ^ Position: (51, 37), right of ',' left of space + + import: warnings-0 +-- ^ Position: (54, 11), right of ':' left of space + + import: warnings-0 +-- ^ Position: (57, 8), not a definition + + -- EOL +-- ^ Position: (59, 7), empty space \ No newline at end of file