From edfc6777739ebe08b7408ccbf7bca86449af687a Mon Sep 17 00:00:00 2001 From: Sean D Gillespie Date: Fri, 13 Sep 2024 21:29:57 -0400 Subject: [PATCH] Replace `expectFail` references with explicit checks --- ghcide/test/exe/Config.hs | 8 + .../test/exe/FindDefinitionAndHoverTests.hs | 49 ++--- ghcide/test/exe/ReferenceTests.hs | 12 +- plugins/hls-cabal-fmt-plugin/test/Main.hs | 5 +- ...ommented_testdata.formatted_document.cabal | 5 +- plugins/hls-cabal-plugin/test/CabalAdd.hs | 8 +- plugins/hls-eval-plugin/test/Main.hs | 4 +- .../test/testdata/T20.expected.hs | 2 +- .../hls-explicit-fixity-plugin/test/Main.hs | 7 +- .../hls-explicit-imports-plugin/test/Main.hs | 20 ++- plugins/hls-refactor-plugin/test/Main.hs | 170 +++++++++--------- .../MultiLinePragma.expected.hs | 2 +- .../OptionsNotAtTopWithSpaces.expected.hs | 2 +- .../OptionsPragmaNotAtTop.expected.hs | 2 +- ...PragmaNotAtTopMultipleComments.expected.hs | 2 +- ...ragmaNotAtTopWithCommentsAtTop.expected.hs | 2 +- .../ShebangNotAtTop.expected.hs | 2 +- .../ShebangNotAtTopNoSpace.expected.hs | 2 +- .../ShebangNotAtTopWithSpaces.expected.hs | 2 +- test/functional/Config.hs | 6 +- 20 files changed, 165 insertions(+), 147 deletions(-) diff --git a/ghcide/test/exe/Config.hs b/ghcide/test/exe/Config.hs index cd58fd5ead..56e9af103a 100644 --- a/ghcide/test/exe/Config.hs +++ b/ghcide/test/exe/Config.hs @@ -30,6 +30,7 @@ module Config( import Control.Exception (bracket_) import Control.Lens.Setter ((.~)) +import Control.Monad (unless) import Data.Foldable (traverse_) import Data.Function ((&)) import qualified Data.Text as T @@ -100,6 +101,7 @@ pattern R x y x' y' = Range (Position x y) (Position x' y') data Expect = ExpectRange Range -- Both gotoDef and hover should report this range + | ExpectRanges [Range] -- definition lookup with multiple results | ExpectLocation Location -- | ExpectDefRange Range -- Only gotoDef should report this range | ExpectHoverRange Range -- Only hover should report this range @@ -124,6 +126,8 @@ checkDefs (defToLocation -> defs) mkExpectations = traverse_ check =<< mkExpecta check (ExpectRange expectedRange) = do def <- assertOneDefinitionFound defs assertRangeCorrect def expectedRange + check (ExpectRanges ranges) = + traverse_ (assertHasRange defs) ranges check (ExpectLocation expectedLocation) = do def <- assertOneDefinitionFound defs liftIO $ do @@ -142,6 +146,10 @@ checkDefs (defToLocation -> defs) mkExpectations = traverse_ check =<< mkExpecta assertRangeCorrect Location{_range = foundRange} expectedRange = liftIO $ expectedRange @=? foundRange + assertHasRange actualRanges expectedRange = do + let hasRange = any (\Location{_range=foundRange} -> foundRange == expectedRange) actualRanges + unless hasRange $ liftIO $ assertFailure $ + "expected range: " <> show expectedRange <> "\nbut got ranges: " <> show defs canonicalizeLocation :: Location -> IO Location canonicalizeLocation (Location uri range) = Location <$> canonicalizeUri uri <*> pure range diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index 63d8dd7ab7..4effc284e9 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -119,8 +119,9 @@ tests = let hover = (getHover , checkHover) -- search locations expectations on results - fffL4 = fffR ^. L.start; fffR = mkRange 8 4 8 7 ; fff = [ExpectRange fffR] - fffL8 = Position 12 4 ; + -- TODO: Lookup of record field should return exactly one result + fffL4 = fffR ^. L.start; fffR = mkRange 8 4 8 7; fff = [ExpectRanges [fffR, mkRange 7 23 9 16]] + fffL8 = Position 12 4 ; fff' = [ExpectRange fffR] fffL14 = Position 18 7 ; aL20 = Position 19 15 aaaL14 = Position 18 20 ; aaa = [mkR 11 0 11 3] @@ -148,13 +149,19 @@ tests = let ; constr = [ExpectHoverText ["Monad m"]] eitL40 = Position 44 28 ; kindE = [ExpectHoverText [":: Type -> Type -> Type\n"]] intL40 = Position 44 34 ; kindI = [ExpectHoverText [":: Type\n"]] - tvrL40 = Position 44 37 ; kindV = [ExpectHoverText [":: * -> *\n"]] - intL41 = Position 45 20 ; litI = [ExpectHoverText ["7518"]] - chrL36 = Position 41 24 ; litC = [ExpectHoverText ["'f'"]] - txtL8 = Position 12 14 ; litT = [ExpectHoverText ["\"dfgy\""]] - lstL43 = Position 47 12 ; litL = [ExpectHoverText ["[8391 :: Int, 6268]"]] + -- TODO: Kind signature of type variables should be `Type -> Type` + tvrL40 = Position 44 37 ; kindV = [ExpectHoverText ["m"]] + -- TODO: Hover of integer literal should be `7518` + intL41 = Position 45 20 ; litI = [ExpectHoverText ["_ :: Int"]] + -- TODO: Hover info of char literal should be `'f'` + chrL36 = Position 41 24 ; litC = [ExpectHoverText ["_ :: Char"]] + -- TODO: Hover info of Text literal should be `"dfgy"` + txtL8 = Position 12 14 ; litT = [ExpectHoverText ["_ :: Text"]] + -- TODO: Hover info of List literal should be `[8391 :: Int, 6268]` + lstL43 = Position 47 12 ; litL = [ExpectHoverText ["[Int]"]] outL45 = Position 49 3 ; outSig = [ExpectHoverText ["outer", "Bool"], mkR 50 0 50 5] - innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7] + -- TODO: Hover info of local function signature should be `inner :: Bool` + innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner"], mkR 53 2 53 7] holeL60 = Position 62 7 ; hleInfo = [ExpectHoverText ["_ ::"]] holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]] cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"] @@ -167,9 +174,9 @@ tests = let mkFindTests -- def hover look expect [ -- It suggests either going to the constructor or to the field - test broken yes fffL4 fff "field in record definition" - , test yes yes fffL8 fff "field in record construction #1102" - , test yes yes fffL14 fff "field name used as accessor" -- https://github.com/haskell/ghcide/pull/120 in Calculate.hs + test yes yes fffL4 fff "field in record definition" + , test yes yes fffL8 fff' "field in record construction #1102" + , test yes yes fffL14 fff' "field name used as accessor" -- https://github.com/haskell/ghcide/pull/120 in Calculate.hs , test yes yes aaaL14 aaa "top-level name" -- https://github.com/haskell/ghcide/pull/120 , test yes yes dcL7 tcDC "data constructor record #1029" , test yes yes dcL12 tcDC "data constructor plain" -- https://github.com/haskell/ghcide/pull/121 @@ -194,15 +201,15 @@ tests = let , test no yes docL41 doc "documentation #1129" , test no yes eitL40 kindE "kind of Either #1017" , test no yes intL40 kindI "kind of Int #1017" - , test no broken tvrL40 kindV "kind of (* -> *) type variable #1017" - , test no broken intL41 litI "literal Int in hover info #1016" - , test no broken chrL36 litC "literal Char in hover info #1016" - , test no broken txtL8 litT "literal Text in hover info #1016" - , test no broken lstL43 litL "literal List in hover info #1016" + , test no yes tvrL40 kindV "kind of (* -> *) type variable #1017" + , test no yes intL41 litI "literal Int in hover info #1016" + , test no yes chrL36 litC "literal Char in hover info #1016" + , test no yes txtL8 litT "literal Text in hover info #1016" + , test no yes lstL43 litL "literal List in hover info #1016" , test yes yes cmtL68 lackOfdEq "no Core symbols #3280" , test no yes docL41 constr "type constraint in hover info #1012" , test no yes outL45 outSig "top-level signature #767" - , test broken broken innL48 innSig "inner signature #767" + , test yes yes innL48 innSig "inner signature #767" , test no yes holeL60 hleInfo "hole without internal name #831" , test no yes holeL65 hleInfo2 "hole with variable" , test no yes cccL17 docLink "Haddock html links" @@ -215,15 +222,11 @@ tests = let , test no yes thLocL57 thLoc "TH Splice Hover" , test yes yes import310 pkgTxt "show package name and its version" ] - where yes, broken :: (TestTree -> Maybe TestTree) - yes = Just -- test should run and pass - broken = Just . (`xfail` "known broken") + where yes :: (TestTree -> Maybe TestTree) + yes = Just -- test should run and pass no = const Nothing -- don't run this test at all --skip = const Nothing -- unreliable, don't run -xfail :: TestTree -> String -> TestTree -xfail = flip expectFailBecause - checkFileCompiles :: FilePath -> Session () -> TestTree checkFileCompiles fp diag = testWithDummyPlugin ("hover: Does " ++ fp ++ " compile") (mkIdeTestFs [copyDir "hover"]) $ do diff --git a/ghcide/test/exe/ReferenceTests.hs b/ghcide/test/exe/ReferenceTests.hs index 013cecaa81..fe6b8c7d04 100644 --- a/ghcide/test/exe/ReferenceTests.hs +++ b/ghcide/test/exe/ReferenceTests.hs @@ -36,7 +36,6 @@ import Test.Hls (FromServerMessage' (..), TNotificationMessage (..)) import Test.Hls.FileSystem (copyDir) import Test.Tasty -import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit @@ -90,16 +89,7 @@ tests = testGroup "references" , ("Main.hs", 10, 0) ] - , expectFailBecause "references provider does not respect includeDeclaration parameter" $ - referenceTest "works when we ask to exclude declarations" - ("References.hs", 4, 7) - NoExcludeDeclaration - [ ("References.hs", 6, 0) - , ("References.hs", 6, 14) - , ("References.hs", 9, 7) - , ("References.hs", 10, 11) - ] - + -- TODO: references provider does not respect includeDeclaration parameter , referenceTest "INCORRECTLY returns declarations when we ask to exclude them" ("References.hs", 4, 7) NoExcludeDeclaration diff --git a/plugins/hls-cabal-fmt-plugin/test/Main.hs b/plugins/hls-cabal-fmt-plugin/test/Main.hs index 5069a9d153..44869779e5 100644 --- a/plugins/hls-cabal-fmt-plugin/test/Main.hs +++ b/plugins/hls-cabal-fmt-plugin/test/Main.hs @@ -39,8 +39,9 @@ tests found = testGroup "cabal-fmt" cabalFmtGolden found "formats a simple document" "simple_testdata" "formatted_document" $ \doc -> do formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - , expectFailBecause "cabal-fmt can't expand modules if .cabal file is read from stdin. Tracking issue: https://github.com/phadej/cabal-fmt/pull/82" $ - cabalFmtGolden found "formats a document with expand:src comment" "commented_testdata" "formatted_document" $ \doc -> do + -- TODO: cabal-fmt can't expand modules if .cabal file is read from stdin. Tracking + -- issue: https://github.com/phadej/cabal-fmt/pull/82 + , cabalFmtGolden found "formats a document with expand:src comment" "commented_testdata" "formatted_document" $ \doc -> do formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) , cabalFmtGolden found "formats a document with lib information" "lib_testdata" "formatted_document" $ \doc -> do diff --git a/plugins/hls-cabal-fmt-plugin/test/testdata/commented_testdata.formatted_document.cabal b/plugins/hls-cabal-fmt-plugin/test/testdata/commented_testdata.formatted_document.cabal index 28f8e040cf..933669a483 100644 --- a/plugins/hls-cabal-fmt-plugin/test/testdata/commented_testdata.formatted_document.cabal +++ b/plugins/hls-cabal-fmt-plugin/test/testdata/commented_testdata.formatted_document.cabal @@ -6,10 +6,7 @@ extra-source-files: CHANGELOG.md library -- cabal-fmt: expand src - exposed-modules: - MyLib - MyOtherLib - + exposed-modules: MyLib build-depends: base ^>=4.14.1.0 hs-source-dirs: src default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs index f6bc7dbde0..d2804b481c 100644 --- a/plugins/hls-cabal-plugin/test/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -17,7 +17,6 @@ import System.FilePath import Test.Hls (Session, TestTree, _R, anyMessage, assertEqual, documentContents, executeCodeAction, - expectFailBecause, getAllCodeActions, getDocumentEdit, liftIO, openDoc, skipManyTill, testCase, testGroup, @@ -100,10 +99,9 @@ cabalAddTests = , ("AAI", "0.1") , ("AWin32Console", "1.19.1") ] - , expectFailBecause "TODO fix regex for these cases" $ - testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" - [ "It is a member of the hidden package \82163d-graphics-examples\8217" - , "It is a member of the hidden package \82163d-graphics-examples-1.1.6\8217" + , testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" + [ "It is a member of the hidden package \8216\&3d-graphics-examples\8217" + , "It is a member of the hidden package \8216\&3d-graphics-examples-1.1.6\8217" ] [ ("3d-graphics-examples", T.empty) , ("3d-graphics-examples", "1.1.6") diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 85c6980849..f2adf6cb85 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -89,8 +89,8 @@ tests = , goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs" , goldenWithEval "Reports an error when given with unknown command" "T18" "hs" , goldenWithEval "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" "T19" "hs" - , expectFailBecause "known issue - see a note in P.R. #361" $ - goldenWithEval ":type +d reflects the `default' declaration of the module" "T20" "hs" + -- TODO: known issue - see a note in P.R. #361 + , goldenWithEval ":type +d reflects the `default' declaration of the module" "T20" "hs" , testCase ":type handles a multilined result properly" $ evalInFile "T21.hs" "-- >>> :type fun" $ T.unlines [ "-- fun", diff --git a/plugins/hls-eval-plugin/test/testdata/T20.expected.hs b/plugins/hls-eval-plugin/test/testdata/T20.expected.hs index 18d2155560..36c93b99c1 100644 --- a/plugins/hls-eval-plugin/test/testdata/T20.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T20.expected.hs @@ -4,4 +4,4 @@ import Data.Word (Word) default (Word) -- >>> :type +d 40+ 2 --- 40+ 2 :: Word +-- 40+ 2 :: Integer 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..01fe1d469e 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -7,6 +7,7 @@ module Main ) where import Control.Lens ((^.)) +import Control.Monad (unless) import Data.Either.Extra import Data.Foldable (find) import Data.Text (Text) @@ -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..ceefc5afd0 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -39,7 +39,6 @@ import qualified System.IO.Extra import System.IO.Extra hiding (withTempDir) import System.Time.Extra import Test.Tasty -import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit import Text.Regex.TDFA ((=~)) @@ -337,67 +336,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" @@ -1513,8 +1506,9 @@ extendImportTests = testGroup "extend import actions" , "x :: (:~:) [] []" , "x = Refl" ]) - , expectFailBecause "importing pattern synonyms is unsupported" - $ testSession "extend import list with pattern synonym" $ template + -- TODO: importing pattern synonyms is unsupported + -- Ideally the result is "Add pattern Some of the import list of A" + , testSession "extend import list with pattern synonym" $ noCodeActionsTemplate [("ModuleA.hs", T.unlines [ "{-# LANGUAGE PatternSynonyms #-}" , "module ModuleA where" @@ -1527,12 +1521,6 @@ extendImportTests = testGroup "extend import actions" , "k (Some x) = x" ]) (Range (Position 2 3) (Position 2 7)) - ["Add pattern Some to the import list of A"] - (T.unlines - [ "module ModuleB where" - , "import A (pattern Some)" - , "k (Some x) = x" - ]) , ignoreForGhcVersions [GHC94] "Diagnostic message has no suggestions" $ testSession "type constructor name same as data constructor name" $ template [("ModuleA.hs", T.unlines @@ -1601,19 +1589,10 @@ extendImportTests = testGroup "extend import actions" codeActionTitle CodeAction{_title=x} = x template setUpModules moduleUnderTest range expectedTitles expectedContentB = do - configureCheckProject overrideCheckProject + docB <- evalProject setUpModules moduleUnderTest + codeActions <- codeActions docB range + let actualTitles = codeActionTitle <$> codeActions - mapM_ (\(fileName, contents) -> createDoc fileName "haskell" contents) setUpModules - docB <- createDoc (fst moduleUnderTest) "haskell" (snd moduleUnderTest) - _ <- waitForDiagnostics - waitForProgressDone - actionsOrCommands <- getCodeActions docB range - let codeActions = - [ ca | InR ca <- actionsOrCommands - , let title = codeActionTitle ca - , "Add" `T.isPrefixOf` title && not ("Add argument" `T.isPrefixOf` title) - ] - actualTitles = codeActionTitle <$> codeActions -- Note that we are not testing the order of the actions, as the -- order of the expected actions indicates which one we'll execute -- in this test, i.e., the first one. @@ -1628,6 +1607,30 @@ extendImportTests = testGroup "extend import actions" contentAfterAction <- documentContents docB liftIO $ expectedContentB @=? contentAfterAction + noCodeActionsTemplate setUpModules moduleUnderTest range = do + docB <- evalProject setUpModules moduleUnderTest + codeActions' <- codeActions docB range + let actualTitles = codeActionTitle <$> codeActions' + liftIO $ [] @=? actualTitles + + evalProject setUpModules moduleUnderTest = do + configureCheckProject overrideCheckProject + + mapM_ (\(fileName, contents) -> createDoc fileName "haskell" contents) setUpModules + docB <- createDoc (fst moduleUnderTest) "haskell" (snd moduleUnderTest) + _ <- waitForDiagnostics + waitForProgressDone + + pure docB + + codeActions docB range = do + actionsOrCommands <- getCodeActions docB range + pure $ + [ ca | InR ca <- actionsOrCommands + , let title = codeActionTitle ca + , "Add" `T.isPrefixOf` title && not ("Add argument" `T.isPrefixOf` title) + ] + fixModuleImportTypoTests :: TestTree fixModuleImportTypoTests = testGroup "fix module import typo" [ testSession "works when single module suggested" $ do @@ -1787,7 +1790,8 @@ suggestImportTests = testGroup "suggest import actions" , test True [] "f = (.|.)" [] "import Data.Bits (Bits(..))" , test True [] "f = empty" [] "import Control.Applicative (Alternative(..))" ] - , expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)" + -- TODO: Importing pattern synonyms is unsupported + , test False [] "k (Some x) = x" [] "import B (pattern Some)" ] where test = test' False 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