diff --git a/plugins/hls-explicit-fixity-plugin/test/Main.hs b/plugins/hls-explicit-fixity-plugin/test/Main.hs index 6cfcc16c60..7b72397c7a 100644 --- a/plugins/hls-explicit-fixity-plugin/test/Main.hs +++ b/plugins/hls-explicit-fixity-plugin/test/Main.hs @@ -40,10 +40,9 @@ tests = testGroup "Explicit fixity" , hoverTest "signature" (Position 35 2) "infixr 9 `>>>:`" , hoverTest "operator" (Position 36 2) "infixr 9 `>>>:`" , hoverTest "escape" (Position 39 2) "infixl 3 `~\\:`" - -- Ensure that there is no one extra new line in import statement - , expectFail $ hoverTest "import" (Position 2 18) "Control.Monad***" - -- Known issue, See https://github.com/haskell/haskell-language-server/pull/2973/files#r916535742 - , expectFail $ hoverTestImport "import" (Position 4 7) "infixr 9 `>>>:`" + -- TODO: Ensure that there is no one extra new line in import statement + , hoverTest "import" (Position 2 18) "Control.Monad\n\n" + , hoverTestImport "import" (Position 4 7) "infixr 9 `>>>:`" ] hoverTest :: TestName -> Position -> T.Text -> TestTree diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 440010bad2..a130603ebd 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -17,6 +17,7 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import System.FilePath (()) import Test.Hls +import Control.Monad (unless) explicitImportsPlugin :: PluginTestDescriptor ExplicitImports.Log explicitImportsPlugin = mkPluginTestDescriptor ExplicitImports.descriptor "explicitImports" @@ -47,7 +48,7 @@ main = defaultTestRunner $ testGroup "import-actions" , inlayHintsTestWithoutCap "ExplicitOnlyThis" 3 $ (@=?) [] -- Only when the client does not support inlay hints, explicit will be provided by code lens , codeLensGoldenTest codeActionNoInlayHintsCaps notRefineImports "ExplicitUsualCase" 0 - , expectFail $ codeLensGoldenTest codeActionNoResolveCaps notRefineImports "ExplicitUsualCase" 0 + , noCodeLensTest codeActionNoResolveCaps "ExplicitUsualCase" , codeActionBreakFile "ExplicitBreakFile" 4 0 , inlayHintsTestWithCap "ExplicitBreakFile" 3 $ (@=?) [mkInlayHint (Position 3 16) "( a1 )" @@ -193,6 +194,23 @@ codeLensGoldenTest caps predicate fp i = goldenWithImportActions " code lens" fp (CodeLens {_command = Just c}) <- pure (filter predicate resolvedCodeLenses !! i) executeCmd c +noCodeLensTest :: ClientCapabilities -> FilePath -> TestTree +noCodeLensTest caps fp = do + testCase (fp ++ " no code lens") $ run $ \_ -> do + doc <- openDoc (fp ++ ".hs") "haskell" + codeLenses <- getCodeLenses doc + resolvedCodeLenses <- for codeLenses resolveCodeLens + unless (null resolvedCodeLenses) $ + liftIO (assertFailure "Unexpected code lens") + where + run = runSessionWithTestConfig def + { testDirLocation = Left testDataDir + , testConfigCaps = caps + , testLspConfig = def + , testPluginDescriptor = explicitImportsPlugin + } + + notRefineImports :: CodeLens -> Bool notRefineImports (CodeLens _ (Just (Command text _ _)) _) | "Refine imports to" `T.isPrefixOf` text = False diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index aa5b5a2a4c..7a7bc3f415 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -337,67 +337,61 @@ insertImportTests = testGroup "insert import" "WhereDeclLowerInFileWithCommentsBeforeIt.hs" "WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs" "import Data.Int" - , expectFailBecause - "'findNextPragmaPosition' function doesn't account for case when shebang is not placed at top of file" - (checkImport - "Shebang not at top with spaces" - "ShebangNotAtTopWithSpaces.hs" - "ShebangNotAtTopWithSpaces.expected.hs" - "import Data.Monoid") - , expectFailBecause - "'findNextPragmaPosition' function doesn't account for case when shebang is not placed at top of file" - (checkImport - "Shebang not at top no space" - "ShebangNotAtTopNoSpace.hs" - "ShebangNotAtTopNoSpace.expected.hs" - "import Data.Monoid") - , expectFailBecause - ("'findNextPragmaPosition' function doesn't account for case " - ++ "when OPTIONS_GHC pragma is not placed at top of file") - (checkImport - "OPTIONS_GHC pragma not at top with spaces" - "OptionsNotAtTopWithSpaces.hs" - "OptionsNotAtTopWithSpaces.expected.hs" - "import Data.Monoid") - , expectFailBecause - ("'findNextPragmaPosition' function doesn't account for " - ++ "case when shebang is not placed at top of file") - (checkImport - "Shebang not at top of file" - "ShebangNotAtTop.hs" - "ShebangNotAtTop.expected.hs" - "import Data.Monoid") - , expectFailBecause - ("'findNextPragmaPosition' function doesn't account for case " - ++ "when OPTIONS_GHC is not placed at top of file") - (checkImport - "OPTIONS_GHC pragma not at top of file" - "OptionsPragmaNotAtTop.hs" - "OptionsPragmaNotAtTop.expected.hs" - "import Data.Monoid") - , expectFailBecause - ("'findNextPragmaPosition' function doesn't account for case when " - ++ "OPTIONS_GHC pragma is not placed at top of file") - (checkImport - "pragma not at top with comment at top" - "PragmaNotAtTopWithCommentsAtTop.hs" - "PragmaNotAtTopWithCommentsAtTop.expected.hs" - "import Data.Monoid") - , expectFailBecause - ("'findNextPragmaPosition' function doesn't account for case when " - ++ "OPTIONS_GHC pragma is not placed at top of file") - (checkImport - "pragma not at top multiple comments" - "PragmaNotAtTopMultipleComments.hs" - "PragmaNotAtTopMultipleComments.expected.hs" - "import Data.Monoid") - , expectFailBecause - "'findNextPragmaPosition' function doesn't account for case of multiline pragmas" - (checkImport - "after multiline language pragmas" - "MultiLinePragma.hs" - "MultiLinePragma.expected.hs" - "import Data.Monoid") + -- TODO: 'findNextPragmaPosition' function doesn't account for case when shebang is not + -- placed at top of file" + , checkImport + "Shebang not at top with spaces" + "ShebangNotAtTopWithSpaces.hs" + "ShebangNotAtTopWithSpaces.expected.hs" + "import Data.Monoid" + -- TODO: 'findNextPragmaPosition' function doesn't account for case when shebang is not + -- placed at top of file" + , checkImport + "Shebang not at top no space" + "ShebangNotAtTopNoSpace.hs" + "ShebangNotAtTopNoSpace.expected.hs" + "import Data.Monoid" + -- TODO: 'findNextPragmaPosition' function doesn't account for case when OPTIONS_GHC pragma is + -- not placed at top of file + , checkImport + "OPTIONS_GHC pragma not at top with spaces" + "OptionsNotAtTopWithSpaces.hs" + "OptionsNotAtTopWithSpaces.expected.hs" + "import Data.Monoid" + -- TODO: findNextPragmaPosition' function doesn't account for case when shebang is not placed + -- at top of file + , checkImport + "Shebang not at top of file" + "ShebangNotAtTop.hs" + "ShebangNotAtTop.expected.hs" + "import Data.Monoid" + -- TODO: findNextPragmaPosition' function doesn't account for case when OPTIONS_GHC is not + -- placed at top of file + , checkImport + "OPTIONS_GHC pragma not at top of file" + "OptionsPragmaNotAtTop.hs" + "OptionsPragmaNotAtTop.expected.hs" + "import Data.Monoid" + -- TODO: findNextPragmaPosition' function doesn't account for case when OPTIONS_GHC pragma is + -- not placed at top of file + , checkImport + "pragma not at top with comment at top" + "PragmaNotAtTopWithCommentsAtTop.hs" + "PragmaNotAtTopWithCommentsAtTop.expected.hs" + "import Data.Monoid" + -- TODO: findNextPragmaPosition' function doesn't account for case when OPTIONS_GHC pragma is + -- not placed at top of file + , checkImport + "pragma not at top multiple comments" + "PragmaNotAtTopMultipleComments.hs" + "PragmaNotAtTopMultipleComments.expected.hs" + "import Data.Monoid" + -- TODO: 'findNextPragmaPosition' function doesn't account for case of multiline pragmas + , checkImport + "after multiline language pragmas" + "MultiLinePragma.hs" + "MultiLinePragma.expected.hs" + "import Data.Monoid" , checkImport "pragmas not at top with module declaration" "PragmaNotAtTopWithModuleDecl.hs" diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/MultiLinePragma.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/MultiLinePragma.expected.hs index ca0b9f28dc..e9e8f4f604 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/MultiLinePragma.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/MultiLinePragma.expected.hs @@ -3,8 +3,8 @@ {-# LANGUAGE RecordWildCards, OverloadedStrings #-} {-# OPTIONS_GHC -Wall, - -Wno-unused-imports #-} import Data.Monoid + -Wno-unused-imports #-} -- some comment diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/OptionsNotAtTopWithSpaces.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/OptionsNotAtTopWithSpaces.expected.hs index 912d6a210c..8595bca913 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/OptionsNotAtTopWithSpaces.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/OptionsNotAtTopWithSpaces.expected.hs @@ -2,7 +2,6 @@ {-# LANGUAGE TupleSections #-} -import Data.Monoid @@ -11,6 +10,7 @@ class Semigroup a => SomeData a instance SomeData All {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +import Data.Monoid addOne :: Int -> Int addOne x = x + 1 diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/OptionsPragmaNotAtTop.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/OptionsPragmaNotAtTop.expected.hs index 55a6c60dbb..a92bbab580 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/OptionsPragmaNotAtTop.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/OptionsPragmaNotAtTop.expected.hs @@ -1,8 +1,8 @@ -import Data.Monoid class Semigroup a => SomeData a instance SomeData All {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +import Data.Monoid addOne :: Int -> Int addOne x = x + 1 diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopMultipleComments.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopMultipleComments.expected.hs index eead1cb55e..cbe451714d 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopMultipleComments.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopMultipleComments.expected.hs @@ -9,7 +9,6 @@ comment -} {-# LANGUAGE TupleSections #-} -import Data.Monoid {- some comment -} -- again @@ -18,6 +17,7 @@ instance SomeData All #! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +import Data.Monoid addOne :: Int -> Int addOne x = x + 1 diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopWithCommentsAtTop.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopWithCommentsAtTop.expected.hs index 57fc1614be..57ab794a7e 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopWithCommentsAtTop.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/PragmaNotAtTopWithCommentsAtTop.expected.hs @@ -4,7 +4,6 @@ -- another comment {-# LANGUAGE TupleSections #-} -import Data.Monoid {- some comment -} @@ -13,6 +12,7 @@ instance SomeData All #! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +import Data.Monoid addOne :: Int -> Int addOne x = x + 1 diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTop.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTop.expected.hs index 09e503ddd3..230710232e 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTop.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTop.expected.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -import Data.Monoid class Semigroup a => SomeData a instance SomeData All #! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +import Data.Monoid f :: Int -> Int f x = x * x diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopNoSpace.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopNoSpace.expected.hs index b367314238..c5977503a6 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopNoSpace.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopNoSpace.expected.hs @@ -1,8 +1,8 @@ -import Data.Monoid class Semigroup a => SomeData a instance SomeData All #! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +import Data.Monoid f :: Int -> Int f x = x * x diff --git a/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopWithSpaces.expected.hs b/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopWithSpaces.expected.hs index 4c6cbe3917..8d358468da 100644 --- a/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopWithSpaces.expected.hs +++ b/plugins/hls-refactor-plugin/test/data/import-placement/ShebangNotAtTopWithSpaces.expected.hs @@ -6,7 +6,6 @@ {-# LANGUAGE TupleSections #-} -import Data.Monoid @@ -16,6 +15,7 @@ instance SomeData All #! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +import Data.Monoid addOne :: Int -> Int addOne x = x + 1 diff --git a/test/functional/Config.hs b/test/functional/Config.hs index 9d11cff3a5..7f2d24a5fd 100644 --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -43,13 +43,13 @@ genericConfigTests = testGroup "generic plugin config" setHlsConfig $ changeConfig "someplugin" def{plcHoverOn = False} -- getting only the expected diagnostics means the plugin wasn't enabled expectDiagnostics standardDiagnostics - , expectFailBecause "partial config is not supported" $ - testCase "custom defaults and non overlapping user config" $ runConfigSession "diagnostics" $ do + -- TODO: Partial config is not supported + , testCase "custom defaults and non overlapping user config" $ runConfigSession "diagnostics" $ do _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False" -- test that the user config doesn't accidentally override the initial config setHlsConfig $ changeConfig testPluginId def{plcHoverOn = False} -- getting only the expected diagnostics means the plugin wasn't enabled - expectDiagnostics standardDiagnostics + expectDiagnostics testPluginDiagnostics , testCase "custom defaults and overlapping user plugin config" $ runConfigSession "diagnostics" $ do _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False" -- test that the user config overrides the default initial config