From 5fbad4d355615a3069209a653a4ca04b3b1043b9 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 3 Feb 2022 08:04:29 +0000 Subject: [PATCH 1/7] Delete useAnnotatedParsedSource (not used anywhere) --- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 18c8e3af76..1c258ddd78 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -23,7 +23,6 @@ module Development.IDE.GHC.ExactPrint transformM, ExactPrint(..), #if !MIN_VERSION_ghc(9,2,0) - useAnnotatedSource, Anns, Annotate, setPrecedingLinesT, @@ -122,16 +121,6 @@ annotateParsedSource :: ParsedModule -> Annotated ParsedSource annotateParsedSource = fixAnns #endif -#if !MIN_VERSION_ghc(9,2,0) -useAnnotatedSource :: - String -> - IdeState -> - NormalizedFilePath -> - IO (Maybe (Annotated ParsedSource)) -useAnnotatedSource herald state nfp = - runAction herald state (use GetAnnotatedParsedSource nfp) -#endif - ------------------------------------------------------------------------------ {- | A transformation for grafting source trees together. Use the semigroup From a2d320c4c2363e1a2234f6d9552d56b4e27bc131 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 3 Feb 2022 08:31:28 +0000 Subject: [PATCH 2/7] Multi component test suite: test packages --- ghcide/test/data/multi/a/A.hs | 2 +- ghcide/test/data/multi/a/a.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/test/data/multi/a/A.hs b/ghcide/test/data/multi/a/A.hs index 1a3672013a..faf037ca84 100644 --- a/ghcide/test/data/multi/a/A.hs +++ b/ghcide/test/data/multi/a/A.hs @@ -1,3 +1,3 @@ module A(foo) where - +import Control.Concurrent.Async foo = () diff --git a/ghcide/test/data/multi/a/a.cabal b/ghcide/test/data/multi/a/a.cabal index d66fc0300c..7675345ca1 100644 --- a/ghcide/test/data/multi/a/a.cabal +++ b/ghcide/test/data/multi/a/a.cabal @@ -4,6 +4,6 @@ build-type: Simple cabal-version: >= 1.2 library - build-depends: base + build-depends: base, async exposed-modules: A hs-source-dirs: . From 065ee31ef751e93337f0d5561f7070de222167dd Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 3 Feb 2022 08:32:11 +0000 Subject: [PATCH 3/7] Multi component test suite: replace delays with waits --- ghcide/test/exe/Main.hs | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 18a348b7c1..423766411b 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5493,12 +5493,10 @@ simpleMultiTest :: TestTree simpleMultiTest = testCase "simple-multi-test" $ withLongTimeout $ runWithExtraFiles "multi" $ \dir -> do let aPath = dir "a/A.hs" bPath = dir "b/B.hs" - aSource <- liftIO $ readFileUtf8 aPath - adoc <- createDoc aPath "haskell" aSource + adoc <- openDoc aPath "haskell" + bdoc <- openDoc bPath "haskell" WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" adoc liftIO $ assertBool "A should typecheck" ideResultSuccess - bSource <- liftIO $ readFileUtf8 bPath - bdoc <- createDoc bPath "haskell" bSource WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" bdoc liftIO $ assertBool "B should typecheck" ideResultSuccess locs <- getDefinitions bdoc (Position 2 7) @@ -5511,15 +5509,14 @@ simpleMultiTest2 :: TestTree simpleMultiTest2 = testCase "simple-multi-test2" $ runWithExtraFiles "multi" $ \dir -> do let aPath = dir "a/A.hs" bPath = dir "b/B.hs" - bSource <- liftIO $ readFileUtf8 bPath - bdoc <- createDoc bPath "haskell" bSource - expectNoMoreDiagnostics 10 - aSource <- liftIO $ readFileUtf8 aPath - (TextDocumentIdentifier adoc) <- createDoc aPath "haskell" aSource - -- Need to have some delay here or the test fails - expectNoMoreDiagnostics 10 + bdoc <- openDoc bPath "haskell" + WaitForIdeRuleResult {} <- waitForAction "TypeCheck" bdoc + adoc@(TextDocumentIdentifier auri) <- openDoc aPath "haskell" + WaitForIdeRuleResult {} <- waitForAction "TypeCheck" adoc locs <- getDefinitions bdoc (Position 2 7) - let fooL = mkL adoc 2 0 2 3 + let fooL = mkL auri 2 0 2 3 + checkDefs locs (pure [fooL]) + expectNoMoreDiagnostics 0.5 checkDefs locs (pure [fooL]) expectNoMoreDiagnostics 0.5 From bf1afd26eebd33faf4eaa1e64de182f05d24035b Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 3 Feb 2022 08:54:13 +0000 Subject: [PATCH 4/7] Multi component: test with 3 components --- ghcide/test/data/multi/c/C.hs | 3 +++ ghcide/test/data/multi/c/c.cabal | 9 +++++++++ ghcide/test/data/multi/cabal.project | 2 +- ghcide/test/data/multi/hie.yaml | 2 ++ ghcide/test/exe/Main.hs | 17 ++++++++++++++++- 5 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 ghcide/test/data/multi/c/C.hs create mode 100644 ghcide/test/data/multi/c/c.cabal diff --git a/ghcide/test/data/multi/c/C.hs b/ghcide/test/data/multi/c/C.hs new file mode 100644 index 0000000000..b75a7fc3c7 --- /dev/null +++ b/ghcide/test/data/multi/c/C.hs @@ -0,0 +1,3 @@ +module C(module C) where +import A +cux = foo diff --git a/ghcide/test/data/multi/c/c.cabal b/ghcide/test/data/multi/c/c.cabal new file mode 100644 index 0000000000..93ee004d94 --- /dev/null +++ b/ghcide/test/data/multi/c/c.cabal @@ -0,0 +1,9 @@ +name: c +version: 1.0.0 +build-type: Simple +cabal-version: >= 1.2 + +library + build-depends: base, a + exposed-modules: C + hs-source-dirs: . diff --git a/ghcide/test/data/multi/cabal.project b/ghcide/test/data/multi/cabal.project index 6ad9e72e04..21bbb8b27b 100644 --- a/ghcide/test/data/multi/cabal.project +++ b/ghcide/test/data/multi/cabal.project @@ -1 +1 @@ -packages: a b +packages: a b c diff --git a/ghcide/test/data/multi/hie.yaml b/ghcide/test/data/multi/hie.yaml index 357e8b68ea..c6b36d012c 100644 --- a/ghcide/test/data/multi/hie.yaml +++ b/ghcide/test/data/multi/hie.yaml @@ -4,3 +4,5 @@ cradle: component: "lib:a" - path: "./b" component: "lib:b" + - path: "./c" + component: "lib:c" diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 423766411b..544b89fbd9 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5373,7 +5373,7 @@ cradleTests = testGroup "cradle" [testGroup "dependencies" [sessionDepsArePickedUp] ,testGroup "ignore-fatal" [ignoreFatalWarning] ,testGroup "loading" [loadCradleOnlyonce, retryFailedCradle] - ,testGroup "multi" [simpleMultiTest, simpleMultiTest2, simpleMultiDefTest] + ,testGroup "multi" [simpleMultiTest, simpleMultiTest2, simpleMultiTest3, simpleMultiDefTest] ,testGroup "sub-directory" [simpleSubDirectoryTest] ] @@ -5517,6 +5517,21 @@ simpleMultiTest2 = testCase "simple-multi-test2" $ runWithExtraFiles "multi" $ \ let fooL = mkL auri 2 0 2 3 checkDefs locs (pure [fooL]) expectNoMoreDiagnostics 0.5 + +-- Now with 3 components +simpleMultiTest3 :: TestTree +simpleMultiTest3 = testCase "simple-multi-test3" $ runWithExtraFiles "multi" $ \dir -> do + let aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + cPath = dir "c/C.hs" + bdoc <- openDoc bPath "haskell" + WaitForIdeRuleResult {} <- waitForAction "TypeCheck" bdoc + adoc@(TextDocumentIdentifier auri) <- openDoc aPath "haskell" + WaitForIdeRuleResult {} <- waitForAction "TypeCheck" adoc + cdoc <- openDoc cPath "haskell" + WaitForIdeRuleResult {} <- waitForAction "TypeCheck" cdoc + locs <- getDefinitions cdoc (Position 2 7) + let fooL = mkL auri 2 0 2 3 checkDefs locs (pure [fooL]) expectNoMoreDiagnostics 0.5 From 6c7fd9980bfcfeb2e431bb14798ca1df863f068f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 5 Feb 2022 07:44:17 +0100 Subject: [PATCH 5/7] Helpers for reference/ready message parsing --- ghcide/test/exe/Main.hs | 27 +++++++++---------------- ghcide/test/src/Development/IDE/Test.hs | 22 +++++++++++++++++++- 2 files changed, 30 insertions(+), 19 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 544b89fbd9..be86a8a6e8 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -58,7 +58,9 @@ import Development.IDE.Test (Cursor, standardizeQuotes, waitForAction, waitForGC, - waitForTypecheck) + waitForTypecheck, + isReferenceReady, + referenceReady) import Development.IDE.Test.Runfiles import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location @@ -5543,11 +5545,7 @@ simpleMultiDefTest = testCase "simple-multi-def-test" $ runWithExtraFiles "multi adoc <- liftIO $ runInDir dir $ do aSource <- liftIO $ readFileUtf8 aPath adoc <- createDoc aPath "haskell" aSource - ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case - FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = fp}) -> do - A.Success fp' <- pure $ fromJSON fp - if equalFilePath fp' aPath then pure () else Nothing - _ -> Nothing + skipManyTill anyMessage $ isReferenceReady aPath closeDoc adoc pure adoc bSource <- liftIO $ readFileUtf8 bPath @@ -5578,18 +5576,15 @@ bootTests = testGroup "boot" -- `ghcide/reference/ready` notification. -- Once we receive one of the above, we wait for the other that we -- haven't received yet. - -- If we don't wait for the `ready` notification it is possible - -- that the `getDefinitions` request/response in the outer ghcide + -- If we don't wait for the `ready` notification it is possible + -- that the `getDefinitions` request/response in the outer ghcide -- session will find no definitions. let hoverParams = HoverParams cDoc (Position 4 3) Nothing hoverRequestId <- sendRequest STextDocumentHover hoverParams - let parseReadyMessage = satisfy $ \case - FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = params}) - | A.Success fp <- fromJSON params -> equalFilePath fp cPath - _ -> False + let parseReadyMessage = isReferenceReady cPath let parseHoverResponse = responseForId STextDocumentHover hoverRequestId hoverResponseOrReadyMessage <- skipManyTill anyMessage ((Left <$> parseHoverResponse) <|> (Right <$> parseReadyMessage)) - _ <- skipManyTill anyMessage $ + _ <- skipManyTill anyMessage $ case hoverResponseOrReadyMessage of Left _ -> void parseReadyMessage Right _ -> void parseHoverResponse @@ -6002,11 +5997,7 @@ referenceTestSession name thisDoc docs' f = testSessionWithExtraFiles "reference loop :: [FilePath] -> Session () loop [] = pure () loop docs = do - doc <- skipManyTill anyMessage $ satisfyMaybe $ \case - FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = fp}) -> do - A.Success fp' <- pure $ fromJSON fp - find (fp' ==) docs - _ -> Nothing + doc <- skipManyTill anyMessage $ referenceReady (`elem` docs) loop (delete doc docs) loop docs f dir diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index 2e7e976b01..7768369adc 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -29,7 +29,13 @@ module Development.IDE.Test , getStoredKeys , waitForCustomMessage , waitForGC - ,getBuildKeysBuilt,getBuildKeysVisited,getBuildKeysChanged,getBuildEdgesCount,configureCheckProject) where + , getBuildKeysBuilt + , getBuildKeysVisited + , getBuildKeysChanged + , getBuildEdgesCount + , configureCheckProject + , isReferenceReady + , referenceReady) where import Control.Applicative.Combinators import Control.Lens hiding (List) @@ -58,6 +64,7 @@ import Language.LSP.Types.Lens as Lsp import System.Directory (canonicalizePath) import System.Time.Extra import Test.Tasty.HUnit +import System.FilePath (equalFilePath) requireDiagnosticM :: (Foldable f, Show (f Diagnostic), HasCallStack) @@ -254,3 +261,16 @@ configureCheckProject overrideCheckProject = sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams $ toJSON def{checkProject = overrideCheckProject}) + +-- | Pattern match a message from ghcide indicating that a file has been indexed +isReferenceReady :: FilePath -> Session () +isReferenceReady p = void $ referenceReady (equalFilePath p) + +referenceReady :: (FilePath -> Bool) -> Session FilePath +referenceReady pred = satisfyMaybe $ \case + FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params}) + | A.Success fp <- A.fromJSON _params + , pred fp + -> Just fp + _ -> Nothing + From 1d9b6a1b385a1866a836f2f547e5b84128cfc87d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 5 Feb 2022 07:52:20 +0100 Subject: [PATCH 6/7] Multi component test: wait for reference ready --- ghcide/test/exe/Main.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index be86a8a6e8..c6cd140924 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5513,8 +5513,8 @@ simpleMultiTest2 = testCase "simple-multi-test2" $ runWithExtraFiles "multi" $ \ bPath = dir "b/B.hs" bdoc <- openDoc bPath "haskell" WaitForIdeRuleResult {} <- waitForAction "TypeCheck" bdoc - adoc@(TextDocumentIdentifier auri) <- openDoc aPath "haskell" - WaitForIdeRuleResult {} <- waitForAction "TypeCheck" adoc + TextDocumentIdentifier auri <- openDoc aPath "haskell" + skipManyTill anyMessage $ isReferenceReady aPath locs <- getDefinitions bdoc (Position 2 7) let fooL = mkL auri 2 0 2 3 checkDefs locs (pure [fooL]) @@ -5528,8 +5528,8 @@ simpleMultiTest3 = testCase "simple-multi-test3" $ runWithExtraFiles "multi" $ \ cPath = dir "c/C.hs" bdoc <- openDoc bPath "haskell" WaitForIdeRuleResult {} <- waitForAction "TypeCheck" bdoc - adoc@(TextDocumentIdentifier auri) <- openDoc aPath "haskell" - WaitForIdeRuleResult {} <- waitForAction "TypeCheck" adoc + TextDocumentIdentifier auri <- openDoc aPath "haskell" + skipManyTill anyMessage $ isReferenceReady aPath cdoc <- openDoc cPath "haskell" WaitForIdeRuleResult {} <- waitForAction "TypeCheck" cdoc locs <- getDefinitions cdoc (Position 2 7) From 28f3513a3b08313be6693abee3599a4484238e26 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 19 Feb 2022 08:15:41 +0000 Subject: [PATCH 7/7] mark test as known broken in 9.2 --- ghcide/test/exe/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index c6cd140924..1189fc1354 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5522,7 +5522,8 @@ simpleMultiTest2 = testCase "simple-multi-test2" $ runWithExtraFiles "multi" $ \ -- Now with 3 components simpleMultiTest3 :: TestTree -simpleMultiTest3 = testCase "simple-multi-test3" $ runWithExtraFiles "multi" $ \dir -> do +simpleMultiTest3 = knownBrokenForGhcVersions [GHC92] "#2693" $ + testCase "simple-multi-test3" $ runWithExtraFiles "multi" $ \dir -> do let aPath = dir "a/A.hs" bPath = dir "b/B.hs" cPath = dir "c/C.hs"