disable checkProject in hls-eval-plugin test suite

pepeiborra · pepeiborra · commit 82517c83b096 · 2021-10-24T15:30:10.000+01:00
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
@@ -405,7 +405,7 @@ test-suite func-test
     , hspec-expectations
     , lens
     , ghcide
-    , hls-test-utils ^>= 1.1.0.0
+    , hls-test-utils ^>= 1.2.0.0
     , lsp-types
     , aeson
     , hls-plugin-api
diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name:          hls-test-utils
-version:       1.1.0.0
+version:       1.2.0.0
 synopsis:      Utilities used in the tests of Haskell Language Server
 description:
   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
@@ -52,7 +52,8 @@ import           Development.IDE.Plugin.Test     (TestRequest (WaitForIdeRule, W
 import           Development.IDE.Types.Options
 import           GHC.IO.Handle
 import           Ide.Plugin.Config               (Config, formattingProvider)
-import           Ide.PluginUtils                 (idePluginsToPluginDesc, pluginDescToIdePlugins)
+import           Ide.PluginUtils                 (idePluginsToPluginDesc,
+                                                  pluginDescToIdePlugins)
 import           Ide.Types
 import           Language.LSP.Test
 import           Language.LSP.Types              hiding
@@ -84,17 +85,17 @@ goldenGitDiff :: TestName -> FilePath -> IO ByteString -> TestTree
 goldenGitDiff name = goldenVsStringDiff name gitDiff
 
 goldenWithHaskellDoc
-  :: PluginDescriptor IdeState
+  :: (Session ByteString -> IO ByteString)
   -> TestName
   -> FilePath
   -> FilePath
   -> FilePath
-  -> FilePath
+  -> String
   -> (TextDocumentIdentifier -> Session ())
   -> TestTree
-goldenWithHaskellDoc plugin title testDataDir path desc ext act =
+goldenWithHaskellDoc runSessionTest title testDataDir path desc ext act =
   goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
-  $ runSessionWithServer plugin testDataDir
+  $ runSessionTest
   $ TL.encodeUtf8 . TL.fromStrict
   <$> do
     doc <- openDoc (path <.> ext) "haskell"
@@ -224,7 +225,7 @@ waitForAction key TextDocumentIdentifier{_uri} = do
     return $ do
       e <- _result
       case A.fromJSON e of
-        A.Error err   -> Left $ ResponseError InternalError (T.pack err) Nothing
+        A.Error err -> Left $ ResponseError InternalError (T.pack err) Nothing
         A.Success a -> pure a
 
 waitForTypecheck :: TextDocumentIdentifier -> Session (Either ResponseError Bool)
diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
@@ -48,4 +48,4 @@ test-suite tests
     , base
     , filepath
     , hls-brittany-plugin
-    , hls-test-utils       >=1.0 && <1.2
+    , hls-test-utils       >=1.0 && <1.3
diff --git a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal
@@ -55,7 +55,7 @@ test-suite tests
     , extra
     , filepath
     , hls-call-hierarchy-plugin
-    , hls-test-utils             >=1.0 && <1.2
+    , hls-test-utils             >=1.0 && <1.3
     , lens
     , lsp
     , lsp-test
diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal
@@ -53,6 +53,6 @@ test-suite tests
     , base
     , filepath
     , hls-class-plugin
-    , hls-test-utils    >=1.0 && <1.2
+    , hls-test-utils    >=1.0 && <1.3
     , lens
     , lsp-types
diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -106,7 +106,8 @@ test-suite tests
     , extra
     , filepath
     , hls-eval-plugin
-    , hls-test-utils   ^>=1.1
+    , hls-plugin-api
+    , hls-test-utils   ^>=1.2
     , lens
     , lsp-types
     , text
diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs
@@ -12,13 +12,14 @@ import           Data.Aeson              (fromJSON)
 import           Data.Aeson.Types        (Result (Success))
 import           Data.List               (isInfixOf)
 import           Data.List.Extra         (nubOrdOn)
+import qualified Data.Text               as T
+import           Ide.Plugin.Config       (checkProject)
 import qualified Ide.Plugin.Eval         as Eval
 import           Ide.Plugin.Eval.Types   (EvalParams (..), Section (..),
                                           testOutput)
 import           Language.LSP.Types.Lens (arguments, command, range, title)
 import           System.FilePath         ((</>))
 import           Test.Hls
-import qualified Data.Text as T
 
 main :: IO ()
 main = defaultTestRunner tests
@@ -30,27 +31,27 @@ tests :: TestTree
 tests =
   testGroup "eval"
   [ testCase "Produces Evaluate code lenses" $
-      runSessionWithServer evalPlugin testDataDir $ do
+      runS evalPlugin testDataDir $ do
         doc <- openDoc "T1.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."]
   , testCase "Produces Refresh code lenses" $
-      runSessionWithServer evalPlugin testDataDir $ do
+      runS evalPlugin testDataDir $ do
         doc <- openDoc "T2.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."]
   , testCase "Code lenses have ranges" $
-      runSessionWithServer evalPlugin testDataDir $ do
+      runS evalPlugin testDataDir $ do
         doc <- openDoc "T1.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
   , testCase "Multi-line expressions have a multi-line range" $ do
-      runSessionWithServer evalPlugin testDataDir $ do
+      runS evalPlugin testDataDir $ do
         doc <- openDoc "T3.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)]
   , testCase "Executed expressions range covers only the expression" $ do
-      runSessionWithServer evalPlugin testDataDir $ do
+      runS evalPlugin testDataDir $ do
         doc <- openDoc "T2.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
@@ -181,7 +182,7 @@ tests =
 
 goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree
 goldenWithEval title path ext =
-  goldenWithHaskellDoc evalPlugin title testDataDir path "expected" ext executeLensesBackwards
+  goldenWithHaskellDoc (runS  evalPlugin testDataDir) title testDataDir path "expected" ext executeLensesBackwards
 
 -- | Execute lenses backwards, to avoid affecting their position in the source file
 executeLensesBackwards :: TextDocumentIdentifier -> Session ()
@@ -208,7 +209,7 @@ executeCmd cmd = do
   pure ()
 
 evalLenses :: FilePath -> IO [CodeLens]
-evalLenses path = runSessionWithServer evalPlugin testDataDir $ do
+evalLenses path = runS evalPlugin testDataDir $ do
   doc <- openDoc path "haskell"
   executeLensesBackwards doc
   getCodeLenses doc
@@ -225,11 +226,17 @@ testDataDir :: FilePath
 testDataDir = "test" </> "testdata"
 
 evalInFile :: FilePath -> T.Text -> T.Text -> IO ()
-evalInFile fp e expected = runSessionWithServer evalPlugin testDataDir $ do
+evalInFile fp e expected = runS evalPlugin testDataDir $ do
   doc <- openDoc fp "haskell"
   origin <- documentContents doc
   let withEval = origin <> e
   changeDoc doc [TextDocumentContentChangeEvent Nothing Nothing withEval]
   executeLensesBackwards doc
   result <- fmap T.strip . T.stripPrefix withEval <$> documentContents doc
   liftIO $ result @?= Just (T.strip expected)
+
+-- Run with checkProject false to avoid loading all the test data modules,
+-- which leads to flaky test failures due to how the Eval plugin mutates
+-- the shared GHC session (this is because of how the InteractiveContext works)
+runS :: PluginDescriptor IdeState -> FilePath -> Session a -> IO a
+runS plugin = runSessionWithServer' [plugin] def{checkProject = False} def fullCaps
diff --git a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal
@@ -40,4 +40,4 @@ test-suite tests
     , base
     , filepath
     , hls-floskell-plugin
-    , hls-test-utils       >=1.0 && <1.2
+    , hls-test-utils       >=1.0 && <1.3
diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal
@@ -44,5 +44,5 @@ test-suite tests
     , base
     , filepath
     , hls-fourmolu-plugin
-    , hls-test-utils       >=1.0 && <1.2
+    , hls-test-utils       >=1.0 && <1.3
     , lsp-test
diff --git a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
@@ -50,5 +50,5 @@ test-suite tests
     , base
     , filepath
     , hls-haddock-comments-plugin
-    , hls-test-utils               >=1.0 && <1.2
+    , hls-test-utils               >=1.0 && <1.3
     , text
diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal
@@ -122,7 +122,7 @@ test-suite tests
     , filepath
     , hls-hlint-plugin
     , hls-plugin-api
-    , hls-test-utils      >=1.0 && <1.2
+    , hls-test-utils      >=1.0 && <1.3
     , lens
     , lsp-types
     , text
diff --git a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal
@@ -44,4 +44,4 @@ test-suite tests
     , base
     , filepath
     , hls-module-name-plugin
-    , hls-test-utils          >=1.0 && <1.2
+    , hls-test-utils          >=1.0 && <1.3
diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal
@@ -43,5 +43,5 @@ test-suite tests
     , base
     , filepath
     , hls-ormolu-plugin
-    , hls-test-utils     >=1.0 && <1.2
+    , hls-test-utils     >=1.0 && <1.3
     , lsp-types
diff --git a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal
@@ -44,7 +44,7 @@ test-suite tests
     , base
     , filepath
     , hls-pragmas-plugin
-    , hls-test-utils      >=1.0 && <1.2
+    , hls-test-utils      >=1.0 && <1.3
     , lens
     , lsp-types
     , text
diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal
@@ -47,4 +47,4 @@ test-suite tests
     , base
     , filepath
     , hls-rename-plugin
-    , hls-test-utils             >=1.0 && <1.2
+    , hls-test-utils             >=1.0 && <1.3
diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal
@@ -64,5 +64,5 @@ test-suite tests
     , base
     , filepath
     , hls-splice-plugin
-    , hls-test-utils     >=1.0 && <1.2
+    , hls-test-utils     >=1.0 && <1.3
     , text
diff --git a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
@@ -42,4 +42,4 @@ test-suite tests
     , base
     , filepath
     , hls-stylish-haskell-plugin
-    , hls-test-utils              >=1.0 && <1.2
+    , hls-test-utils              >=1.0 && <1.3
diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
@@ -160,7 +160,7 @@ test-suite tests
     , ghcide
     , hls-plugin-api
     , hls-tactics-plugin
-    , hls-test-utils      >=1.0 && <1.2
+    , hls-test-utils      >=1.0 && <1.3
     , hspec
     , hspec-expectations
     , lens
