From 4f473a954444b71f78d169703447fefa04b96b2f Mon Sep 17 00:00:00 2001 From: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> Date: Fri, 26 Jan 2024 11:36:36 +0100 Subject: [PATCH] refactor plugin: add reproducer and fix for #3795 (#4016) * refactor plugin: add reproducer for #3795, fix few warnings in test * Simplify reproducer, first attempt at fix --- .../hls-refactor-plugin.cabal | 2 +- .../IDE/Plugin/Plugins/Diagnostic.hs | 5 +- plugins/hls-refactor-plugin/test/Main.hs | 88 +++++++++++-------- .../test/Test/AddArgument.hs | 4 +- 4 files changed, 59 insertions(+), 40 deletions(-) diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 7678c360c15..6a8e07220b1 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -102,7 +102,7 @@ test-suite tests hs-source-dirs: test main-is: Main.hs other-modules: Test.AddArgument - ghc-options: -O0 -threaded -rtsopts -with-rtsopts=-N -Wunused-imports + ghc-options: -O0 -threaded -rtsopts -with-rtsopts=-N -Wno-name-shadowing build-depends: , base , filepath diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/Diagnostic.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/Diagnostic.hs index e99c23de984..d64edbd0e25 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/Diagnostic.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/Diagnostic.hs @@ -44,7 +44,10 @@ matchVariableNotInScope message | otherwise = Nothing where matchVariableNotInScopeTyped message - | Just [name, typ] <- matchRegexUnifySpaces message "Variable not in scope: ([^ ]+) :: ([^*•]+)" = + | Just [name, typ0] <- matchRegexUnifySpaces message "Variable not in scope: ([^ ]+) :: ([^*•]+)" + , -- When some name in scope is similar to not-in-scope variable, the type is followed by + -- "Suggested fix: Perhaps use ..." + typ:_ <- T.splitOn " Suggested fix:" typ0 = Just (name, typ) | otherwise = Nothing matchVariableNotInScopeUntyped message diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 28e163bc3fc..4408f799326 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -9,7 +9,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-} +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} module Main ( main @@ -33,9 +33,7 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length), - SemanticTokensEdit (_start), + (SemanticTokensEdit (_start), mkRange) import Language.LSP.Test import System.Directory @@ -81,6 +79,7 @@ tests = , completionTests ] +initializeTests :: TestTree initializeTests = withResource acquire release tests where tests :: IO (TResponseMessage Method_Initialize) -> TestTree @@ -640,7 +639,10 @@ renameActionTests = testGroup "rename actions" doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics actionsOrCommands <- getCodeActions doc (Range (Position 3 12) (Position 3 20)) - [fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "monus" `T.isInfixOf` actionTitle , "Replace" `T.isInfixOf` actionTitle] + [fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands + , "monus" `T.isInfixOf` actionTitle + , "Replace" `T.isInfixOf` actionTitle + ] executeCodeAction fixTypo contentAfterAction <- documentContents doc let expectedContentAfterAction = T.unlines @@ -659,9 +661,11 @@ renameActionTests = testGroup "rename actions" , "foo = 'bread" ] doc <- createDoc "Testing.hs" "haskell" content - diags <- waitForDiagnostics + _ <- waitForDiagnostics actionsOrCommands <- getCodeActions doc (Range (Position 4 6) (Position 4 12)) - [fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "break" `T.isInfixOf` actionTitle ] + [fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands + , "break" `T.isInfixOf` actionTitle + ] executeCodeAction fixTypo contentAfterAction <- documentContents doc let expectedContentAfterAction = T.unlines @@ -776,9 +780,9 @@ typeWildCardActionTests = testGroup "type wildcard actions" doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics actionsOrCommands <- getAllCodeActions doc - let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands - , "Use type signature" `T.isInfixOf` actionTitle - ] + [addSignature] <- pure [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands + , "Use type signature" `T.isInfixOf` actionTitle + ] executeCodeAction addSignature contentAfterAction <- documentContents doc liftIO $ expectedContentAfterAction @=? contentAfterAction @@ -1782,7 +1786,7 @@ suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields w doc <- createDoc "Test.hs" "haskell" before waitForProgressDone _ <- waitForDiagnostics - let defLine = fromIntegral $ 1 + 2 + let defLine = 3 range = Range (Position defLine 0) (Position defLine maxBound) actions <- getCodeActions doc range action <- liftIO $ pickActionWithTitle "Add foo to the import list of B" actions @@ -1913,7 +1917,6 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti contentAfterAction <- documentContents doc liftIO $ T.replace "\r\n" "\n" expected @=? contentAfterAction compareHideFunctionTo = compareTwo "HideFunction.hs" - auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"] withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do doc <- openDoc file "haskell" void $ expectDiagnostics [(file, [(DiagnosticSeverity_Error, loc, "Ambiguous occurrence") | loc <- locs])] @@ -2122,9 +2125,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions" ] docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB') _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$> - getCodeActions docB (R 0 0 0 50) + action@CodeAction { _title = actionTitle } : _ + <- findCodeActionsByPrefix docB (R 0 0 0 50) ["Define"] liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool" executeCodeAction action contentAfterAction <- documentContents docB @@ -2134,6 +2136,27 @@ insertNewDefinitionTests = testGroup "insert new definition actions" , "select = _" ] ++ txtB') + , testSession "insert new function definition - with similar suggestion in scope" $ do + doc <- createDoc "Module.hs" "haskell" $ T.unlines + [ "import Control.Monad" -- brings `mplus` into scope, leading to additional suggestion + -- "Perhaps use \8216mplus\8217 (imported from Control.Monad)" + , "f :: Int -> Int" + , "f x = plus x x" + ] + _ <- waitForDiagnostics + action@CodeAction { _title = actionTitle } : _ + <- findCodeActionsByPrefix doc (R 2 0 2 13) ["Define"] + liftIO $ actionTitle @?= "Define plus :: Int -> Int -> Int" + executeCodeAction action + contentAfterAction <- documentContents doc + liftIO $ contentAfterAction @?= T.unlines + [ "import Control.Monad" + , "f :: Int -> Int" + , "f x = plus x x" + , "" + , "plus :: Int -> Int -> Int" + , "plus = _" + ] , testSession "define a hole" $ do let txtB = ["foo True = _select [True]" @@ -2146,9 +2169,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions" ] docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB') _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$> - getCodeActions docB (R 0 0 0 50) + action@CodeAction { _title = actionTitle } : _ + <- findCodeActionsByPrefix docB (R 0 0 0 50) ["Define"] liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool" executeCodeAction action contentAfterAction <- documentContents docB @@ -2180,9 +2202,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions" , "haddock = undefined"] docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start) _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$> - getCodeActions docB (R 1 0 0 50) + action@CodeAction { _title = actionTitle } : _ + <- findCodeActionsByPrefix docB (R 1 0 0 50) ["Define"] liftIO $ actionTitle @?= "Define select :: Int -> Bool" executeCodeAction action contentAfterAction <- documentContents docB @@ -2206,9 +2227,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions" , "normal = undefined"] docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start) _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$> - getCodeActions docB (R 1 0 0 50) + action@CodeAction { _title = actionTitle } : _ + <- findCodeActionsByPrefix docB (R 1 0 0 50) ["Define"] liftIO $ actionTitle @?= "Define select :: Int -> Bool" executeCodeAction action contentAfterAction <- documentContents docB @@ -2223,9 +2243,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions" ] docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB') _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$> - getCodeActions docB (R 0 0 0 50) + action@CodeAction { _title = actionTitle } : _ <- + findCodeActionsByPrefix docB (R 0 0 0 50) ["Define"] liftIO $ actionTitle @?= "Define select :: _" executeCodeAction action contentAfterAction <- documentContents docB @@ -2237,6 +2256,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions" ++ txtB') ] + deleteUnusedDefinitionTests :: TestTree deleteUnusedDefinitionTests = testGroup "delete unused definition action" [ testSession "delete unused top level binding" $ @@ -2573,8 +2593,10 @@ importRenameActionTests = testGroup "import rename actions" ] doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 1 8) (Position 1 16)) - let [changeToMap] = [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, ("Data." <> modname) `T.isInfixOf` actionTitle ] + actionsOrCommands <- getCodeActions doc (R 1 8 1 16) + [changeToMap] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands + , ("Data." <> modname) `T.isInfixOf` actionTitle + ] executeCodeAction changeToMap contentAfterAction <- documentContents doc let expectedContentAfterAction = T.unlines @@ -3845,12 +3867,8 @@ pattern R x y x' y' = Range (Position x y) (Position x' y') -- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or -- @/var@ withTempDir :: (FilePath -> IO a) -> IO a -withTempDir f = System.IO.Extra.withTempDir $ \dir -> do - dir' <- canonicalizePath dir - f dir' - -ignoreForGHC92 :: String -> TestTree -> TestTree -ignoreForGHC92 = ignoreForGhcVersions [GHC92] +withTempDir f = System.IO.Extra.withTempDir $ \dir -> + canonicalizePath dir >>= f brokenForGHC94 :: String -> TestTree -> TestTree brokenForGHC94 = knownBrokenForGhcVersions [GHC94] diff --git a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs index c08870266fd..8d08624d40a 100644 --- a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs +++ b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs @@ -12,9 +12,7 @@ import Data.List.Extra import qualified Data.Text as T import Development.IDE.Types.Location import Language.LSP.Protocol.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length), - SemanticTokensEdit (_start), + (SemanticTokensEdit (_start), mkRange) import Language.LSP.Test import Test.Tasty