From 8832014729d8222c3087583d145274e50296fe3e Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sat, 27 Mar 2021 23:11:25 +0800
Subject: [PATCH 01/14] Run plugins' test suites with server in the same
 process

---
 .github/workflows/test.yml                    | 12 +--
 hls-test-utils/hls-test-utils.cabal           |  5 +-
 hls-test-utils/src/Test/Hls.hs                | 94 ++++++++++++++++---
 .../hls-brittany-plugin.cabal                 | 15 ---
 plugins/hls-brittany-plugin/test/Main.hs      | 18 ++--
 plugins/hls-brittany-plugin/test/Server.hs    | 19 ----
 .../hls-class-plugin/hls-class-plugin.cabal   | 21 +----
 plugins/hls-class-plugin/test/Main.hs         |  8 +-
 plugins/hls-class-plugin/test/Server.hs       | 18 ----
 plugins/hls-eval-plugin/hls-eval-plugin.cabal | 14 ---
 plugins/hls-eval-plugin/test/Main.hs          | 28 +++---
 plugins/hls-eval-plugin/test/Server.hs        | 17 ----
 .../hls-haddock-comments-plugin.cabal         | 21 +----
 .../hls-haddock-comments-plugin/test/Main.hs  | 20 ++--
 .../test/Server.hs                            | 18 ----
 .../hls-splice-plugin/hls-splice-plugin.cabal | 14 ---
 plugins/hls-splice-plugin/test/Main.hs        | 14 ++-
 plugins/hls-splice-plugin/test/Server.hs      | 17 ----
 .../hls-stylish-haskell-plugin.cabal          | 21 +----
 .../hls-stylish-haskell-plugin/test/Main.hs   | 16 ++--
 .../hls-stylish-haskell-plugin/test/Server.hs | 18 ----
 21 files changed, 167 insertions(+), 261 deletions(-)
 delete mode 100644 plugins/hls-brittany-plugin/test/Server.hs
 delete mode 100644 plugins/hls-class-plugin/test/Server.hs
 delete mode 100644 plugins/hls-eval-plugin/test/Server.hs
 delete mode 100644 plugins/hls-haddock-comments-plugin/test/Server.hs
 delete mode 100644 plugins/hls-splice-plugin/test/Server.hs
 delete mode 100644 plugins/hls-stylish-haskell-plugin/test/Server.hs

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index d2a563c5af..f14885198c 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -140,27 +140,27 @@ jobs:
 
       - name: Test hls-brittany-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-brittany-plugin || cabal test hls-brittany-plugin --test-options="-j1"
+        run: cabal test hls-brittany-plugin --test-options="--rerun-update" || cabal test hls-brittany-plugin --test-options="--rerun"
 
       - name: Test hls-class-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-class-plugin || cabal test hls-class-plugin --test-options="-j1"
+        run: cabal test hls-class-plugin --test-options="--rerun-update" || cabal test hls-class-plugin --test-options="--rerun"
 
       - name: Test hls-eval-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-eval-plugin --test-options="-j1 --rerun" || cabal test hls-eval-plugin --test-options="-j1 --rerun"
+        run: cabal test hls-eval-plugin --test-options="--rerun-update" || cabal test hls-eval-plugin --test-options="--rerun"
 
       - name: Test hls-haddock-comments-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-haddock-comments-plugin || cabal test hls-haddock-comments-plugin --test-options="-j1"
+        run: cabal test hls-haddock-comments-plugin --test-options="--rerun-update" || cabal test hls-haddock-comments-plugin --test-options="--rerun"
 
       - name: Test hls-splice-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-splice-plugin || cabal test hls-splice-plugin --test-options="-j1"
+        run: cabal test hls-splice-plugin --test-options="--rerun-update" || cabal test hls-splice-plugin --test-options="--rerun"
 
       - name: Test hls-stylish-haskell-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-stylish-haskell-plugin || cabal test hls-stylish-haskell-plugin --test-options="-j1"
+        run: cabal test hls-stylish-haskell-plugin --test-options="--rerun-update" || cabal test hls-stylish-haskell-plugin --test-options="--rerun"
 
       - name: Test hls-tactics-plugin test suite
         if: ${{ matrix.test }}
diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal
index f0ec162c34..7ed46638ef 100644
--- a/hls-test-utils/hls-test-utils.cabal
+++ b/hls-test-utils/hls-test-utils.cabal
@@ -42,13 +42,16 @@ library
     , directory
     , extra
     , filepath
+    , ghcide                  ^>=1.1.0.0
+    , hls-plugin-api          ^>=1.1.0.0
     , hspec
     , hspec-core
     , lens
+    , lsp                     ^>=1.2
     , lsp-test                ==0.14.0.0
     , lsp-types               ^>=1.2
+    , shake
     , tasty
-    , tasty-ant-xml           >=1.1.6
     , tasty-expected-failure
     , tasty-golden
     , tasty-hunit
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 10cb8eefb1..a4be16e8fc 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -9,32 +9,51 @@ module Test.Hls
     module Control.Applicative.Combinators,
     defaultTestRunner,
     goldenGitDiff,
-    testCommand,
     def,
+    runSessionWithServer,
+    runSessionWithServerFormatter,
+    runSessionWithServer',
+    PluginDescriptor,
+    IdeState,
   )
 where
 
 import           Control.Applicative.Combinators
+import           Control.Concurrent                (forkIO, killThread)
+import           Control.Exception.Base
 import           Control.Monad.IO.Class
-import           Data.ByteString.Lazy            (ByteString)
-import           Data.Default                    (def)
+import           Data.ByteString.Lazy              (ByteString)
+import           Data.Default                      (def)
+import qualified Data.Text                         as T
+import           Development.IDE                   (IdeState, hDuplicateTo',
+                                                    noLogging)
+import           Development.IDE.Main
+import qualified Development.IDE.Main              as Ghcide
+import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
+import           Development.IDE.Types.Options
+import           Development.Shake                 (ShakeOptions (shakeThreads))
+import           GHC.IO.Handle
+import           Ide.Plugin.Config                 (Config, formattingProvider)
+import           Ide.PluginUtils                   (pluginDescToIdePlugins)
+import           Ide.Types
 import           Language.LSP.Test
 import           Language.LSP.Types
+import           Language.LSP.Types.Capabilities   (ClientCapabilities)
+import           System.Directory                  (getCurrentDirectory,
+                                                    setCurrentDirectory)
+import           System.IO.Extra
+import           System.Process.Extra              (createPipe)
 import           Test.Hls.Util
-import           Test.Tasty                      hiding (Timeout)
+import           Test.Tasty                        hiding (Timeout)
 import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.Golden
 import           Test.Tasty.HUnit
 import           Test.Tasty.Ingredients.Rerun
 import           Test.Tasty.Runners
-import           Test.Tasty.Runners.AntXML
 
--- | ingredient: xml runner writes json file of test results (https://github.com/ocharles/tasty-ant-xml/blob/master/Test/Tasty/Runners/AntXML.hs)
---               rerunningTests allow rerun of failed tests (https://github.com/ocharles/tasty-rerun/blob/master/src/Test/Tasty/Ingredients/Rerun.hs)
+-- | Run 'defaultMainWithRerun' with -j1, and silence stderr
 defaultTestRunner :: TestTree -> IO ()
-defaultTestRunner =
-  defaultMainWithIngredients
-    [antXMLRunner, rerunningTests [listingTests, consoleTestReporter]]
+defaultTestRunner = muteStderr . defaultMainWithRerun . adjustOption (const $ NumThreads 1)
 
 gitDiff :: FilePath -> FilePath -> [String]
 gitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
@@ -42,5 +61,56 @@ gitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef,
 goldenGitDiff :: TestName -> FilePath -> IO ByteString -> TestTree
 goldenGitDiff name = goldenVsStringDiff name gitDiff
 
-testCommand :: String
-testCommand = "test-server"
+runSessionWithServer :: PluginDescriptor IdeState -> FilePath -> Session a -> IO a
+runSessionWithServer plugin = runSessionWithServer' [plugin] def def fullCaps
+
+runSessionWithServerFormatter :: PluginDescriptor IdeState -> String -> FilePath -> Session a -> IO a
+runSessionWithServerFormatter plugin formatter =
+  runSessionWithServer'
+    [plugin]
+    def {formattingProvider = T.pack formatter}
+    def
+    fullCaps
+
+-- | Silence stderr, running an action
+muteStderr :: IO () -> IO ()
+muteStderr action = withTempFile $ \tmp ->
+  bracket (openFile tmp AppendMode) hClose $ \h -> do
+    old <- hDuplicate stderr
+    h `hDuplicateTo'` stderr
+    bracket_ action (hClose old) (old `hDuplicateTo'` stderr)
+
+
+-- | Host a server, and run a test session on it
+-- Note: cwd will be shifted into @root@ in @Session a@
+runSessionWithServer' ::
+  -- | plugins to load on the server
+  [PluginDescriptor IdeState] ->
+  -- | lsp config for the server
+  Config ->
+  -- | config for the test session
+  SessionConfig ->
+  ClientCapabilities ->
+  FilePath ->
+  Session a ->
+  IO a
+runSessionWithServer' plugin conf sconf caps root s = do
+  (inR, inW) <- createPipe
+  (outR, outW) <- createPipe
+  -- restore cwd after running the session; otherwise the path to test data will be invalid
+  cwd <- getCurrentDirectory
+  threadId <-
+    forkIO $
+      Ghcide.defaultMain
+        def
+          { argsHandleIn = pure inR,
+            argsHandleOut = pure outW,
+            argsLogger = pure noLogging,
+            argsDefaultHlsConfig = conf,
+            argsIdeOptions = \config sessionLoader ->
+              let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
+               in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
+            argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
+          }
+  runSessionWithHandles inW outR sconf caps root s
+    `finally` (killThread threadId >> setCurrentDirectory cwd)
diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
index 6e875daf57..41179da871 100644
--- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
+++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
@@ -31,24 +31,9 @@ library
 
   default-language: Haskell2010
 
-executable test-server
-  default-language:   Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-brittany-plugin
-    , hls-plugin-api
-    , shake
-  main-is: Server.hs
-  hs-source-dirs: test
-  ghc-options: -threaded
-
 test-suite tests
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010
-  build-tool-depends:
-    hls-brittany-plugin:test-server -any,
   hs-source-dirs: test
   main-is: Main.hs
   build-depends:
diff --git a/plugins/hls-brittany-plugin/test/Main.hs b/plugins/hls-brittany-plugin/test/Main.hs
index 0d981947b5..4f8f185328 100644
--- a/plugins/hls-brittany-plugin/test/Main.hs
+++ b/plugins/hls-brittany-plugin/test/Main.hs
@@ -2,32 +2,36 @@
 module Main(main) where
 
 import qualified Data.ByteString.Lazy as BS
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
-import Test.Hls
+import qualified Data.Text.Encoding   as T
+import qualified Data.Text.IO         as T
+import qualified Ide.Plugin.Brittany  as Brittany
+import           Test.Hls
 
 main :: IO ()
 main = defaultTestRunner tests
 
+plugin :: PluginDescriptor IdeState
+plugin = Brittany.descriptor "brittany"
+
 tests :: TestTree
 tests = testGroup "brittany" [
-    goldenGitDiff "formats a document with LF endings" "test/testdata/BrittanyLF.formatted_document.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    goldenGitDiff "formats a document with LF endings" "test/testdata/BrittanyLF.formatted_document.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyLF.hs" "haskell"
         formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
-    , goldenGitDiff "formats a document with CRLF endings" "test/testdata/BrittanyCRLF.formatted_document.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    , goldenGitDiff "formats a document with CRLF endings" "test/testdata/BrittanyCRLF.formatted_document.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyCRLF.hs" "haskell"
         formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
-    , goldenGitDiff "formats a range with LF endings" "test/testdata/BrittanyLF.formatted_range.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    , goldenGitDiff "formats a range with LF endings" "test/testdata/BrittanyLF.formatted_range.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyLF.hs" "haskell"
         let range = Range (Position 1 0) (Position 2 22)
         formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) range
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
-    , goldenGitDiff "formats a range with CRLF endings" "test/testdata/BrittanyCRLF.formatted_range.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    , goldenGitDiff "formats a range with CRLF endings" "test/testdata/BrittanyCRLF.formatted_range.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyCRLF.hs" "haskell"
         let range = Range (Position 1 0) (Position 2 22)
         formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) range
diff --git a/plugins/hls-brittany-plugin/test/Server.hs b/plugins/hls-brittany-plugin/test/Server.hs
deleted file mode 100644
index 192103ec9c..0000000000
--- a/plugins/hls-brittany-plugin/test/Server.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Main(main) where
-
-import Data.Default
-import Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import Ide.Plugin.Config
-import Ide.Plugin.Brittany as B
-import Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ B.descriptor "brittany"
-    ] <>
-    Ghcide.descriptors
-  , argsDefaultHlsConfig = def { formattingProvider = "brittany" }
-  }
diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal
index 45433bd2a0..9d651983c5 100644
--- a/plugins/hls-class-plugin/hls-class-plugin.cabal
+++ b/plugins/hls-class-plugin/hls-class-plugin.cabal
@@ -45,29 +45,16 @@ library
 
   ghc-options:        -Wno-unticked-promoted-constructors
 
-executable test-server
+test-suite tests
+  type:             exitcode-stdio-1.0
   default-language: Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-class-plugin
-    , hls-plugin-api
-
-  main-is:          Server.hs
   hs-source-dirs:   test
-  ghc-options:      -threaded
-
-test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  build-tool-depends: hls-class-plugin:test-server -any
-  hs-source-dirs:     test
-  main-is:            Main.hs
+  main-is:          Main.hs
   build-depends:
     , base
     , bytestring
     , filepath
+    , hls-class-plugin
     , hls-test-utils
     , lens
     , lsp-test
diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs
index af8495e46b..140a540045 100644
--- a/plugins/hls-class-plugin/test/Main.hs
+++ b/plugins/hls-class-plugin/test/Main.hs
@@ -10,6 +10,7 @@ where
 import           Control.Lens            hiding ((<.>))
 import qualified Data.ByteString.Lazy    as BS
 import qualified Data.Text.Encoding      as T
+import qualified Ide.Plugin.Class        as Class
 import qualified Language.LSP.Types.Lens as J
 import           System.FilePath
 import           Test.Hls
@@ -17,11 +18,14 @@ import           Test.Hls
 main :: IO ()
 main = defaultTestRunner tests
 
+plugin :: PluginDescriptor IdeState
+plugin = Class.descriptor "class"
+
 tests :: TestTree
 tests = testGroup
   "class"
   [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do
-      runSession testCommand fullCaps classPath $ do
+      runSessionWithServer plugin classPath $ do
         doc <- openDoc "T1.hs" "haskell"
         _ <- waitForDiagnosticsFromSource doc "typecheck"
         caResults <- getAllCodeActions doc
@@ -61,7 +65,7 @@ classPath = "test" </> "testdata"
 glodenTest :: String -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree
 glodenTest name fp deco execute
   = goldenGitDiff name (classPath </> fpWithDeco <.> "expected" <.> "hs")
-    $ runSession testCommand fullCaps classPath
+    $ runSessionWithServer plugin classPath
     $ do
       doc <- openDoc (fp <.> "hs") "haskell"
       _ <- waitForDiagnosticsFromSource doc "typecheck"
diff --git a/plugins/hls-class-plugin/test/Server.hs b/plugins/hls-class-plugin/test/Server.hs
deleted file mode 100644
index 584c52cd1b..0000000000
--- a/plugins/hls-class-plugin/test/Server.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-
-{-# LANGUAGE OverloadedStrings #-}
-module Main(main) where
-
-import           Data.Default
-import           Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import qualified Ide.Plugin.Class                  as Class
-import           Ide.Plugin.Config
-import           Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ Class.descriptor "class"
-    ] <>
-    Ghcide.descriptors
-  }
diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
index 7b2dcaf957..e98772fb66 100644
--- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal
+++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -92,23 +92,9 @@ library
     DataKinds
     TypeOperators
 
-executable test-server
-  default-language: Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-eval-plugin
-    , hls-plugin-api
-
-  main-is:          Server.hs
-  hs-source-dirs:   test
-  ghc-options:      -threaded
-
 test-suite tests
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010
-  build-tool-depends: hls-eval-plugin:test-server -any
   hs-source-dirs:     test
   main-is:            Main.hs
 
diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs
index 3cc5935601..ae14832741 100644
--- a/plugins/hls-eval-plugin/test/Main.hs
+++ b/plugins/hls-eval-plugin/test/Main.hs
@@ -15,6 +15,7 @@ import           Data.Aeson.Types        (Result (Success))
 import           Data.List.Extra         (nubOrdOn)
 import qualified Data.Text               as T
 import qualified Data.Text.IO            as T
+import qualified Ide.Plugin.Eval         as Eval
 import           Ide.Plugin.Eval.Types   (EvalParams (..))
 import           Language.LSP.Types.Lens (command, range, title)
 import           System.Directory        (doesFileExist)
@@ -24,32 +25,35 @@ import           Test.Hls
 main :: IO ()
 main = defaultTestRunner tests
 
+evalPlugin :: PluginDescriptor IdeState
+evalPlugin = Eval.descriptor "eval"
+
 tests :: TestTree
 tests =
     testGroup
         "eval"
         [ testCase "Produces Evaluate code lenses" $
-            runSession testCommand fullCaps evalPath $ do
+            runSessionWithServer evalPlugin evalPath $ do
                 doc <- openDoc "T1.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
                 liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."]
         , testCase "Produces Refresh code lenses" $
-            runSession testCommand fullCaps evalPath $ do
+            runSessionWithServer evalPlugin evalPath $ do
                 doc <- openDoc "T2.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
                 liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."]
         , testCase "Code lenses have ranges" $
-            runSession testCommand fullCaps evalPath $ do
+            runSessionWithServer evalPlugin evalPath $ do
                 doc <- openDoc "T1.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
                 liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
         , testCase "Multi-line expressions have a multi-line range" $ do
-            runSession testCommand fullCaps evalPath $ do
+            runSessionWithServer evalPlugin evalPath $ do
                 doc <- openDoc "T3.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
                 liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)]
         , testCase "Executed expressions range covers only the expression" $ do
-            runSession testCommand fullCaps evalPath $ do
+            runSessionWithServer evalPlugin evalPath $ do
                 doc <- openDoc "T2.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
                 liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
@@ -132,12 +136,10 @@ tests =
             "Can handle eval inside nested comment properly"
             $ goldenTest "TNested.hs"
         , testCase "Test on last line insert results correctly" $ do
-            runSession testCommand fullCaps evalPath $
-                liftIO $ do
-                    let mdl = "TLastLine.hs"
-                    -- Write the test file, to make sure that it has no final line return
-                    writeFile (evalPath </> mdl) "module TLastLine where\n\n-- >>> take 3 [1..]"
-                    goldenTest mdl
+                let mdl = "TLastLine.hs"
+                -- Write the test file, to make sure that it has no final line return
+                writeFile (evalPath </> mdl) "module TLastLine where\n\n-- >>> take 3 [1..]"
+                goldenTest mdl
             , testGroup "with preprocessors"
             [ knownBrokenInEnv [HostOS Windows, GhcVer GHC84, GhcVer GHC86]
                 "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $
@@ -160,7 +162,7 @@ goldenTest = goldenTestBy isEvalTest
  Compare results with the contents of corresponding '.expected' file (and creates it, if missing)
 -}
 goldenTestBy :: (CodeLens -> Bool) -> FilePath -> IO ()
-goldenTestBy fltr input = runSession testCommand fullCaps evalPath $ do
+goldenTestBy fltr input = runSessionWithServer evalPlugin evalPath $ do
     doc <- openDoc input "haskell"
 
     -- Execute lenses backwards, to avoid affecting their position in the source file
@@ -176,7 +178,7 @@ goldenTestBy fltr input = runSession testCommand fullCaps evalPath $ do
     edited <- replaceUnicodeQuotes <$> documentContents doc
     -- liftIO $ T.putStrLn edited
 
-    let expectedFile = evalPath </> input <.> "expected"
+    let expectedFile = input <.> "expected"
 
     liftIO $ do
         -- Write expected file if missing
diff --git a/plugins/hls-eval-plugin/test/Server.hs b/plugins/hls-eval-plugin/test/Server.hs
deleted file mode 100644
index a30263fc46..0000000000
--- a/plugins/hls-eval-plugin/test/Server.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main(main) where
-
-import           Data.Default
-import           Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import           Ide.Plugin.Config
-import qualified Ide.Plugin.Eval                   as Eval
-import           Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ Eval.descriptor "eval"
-    ] <>
-    Ghcide.descriptors
-  }
diff --git a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
index d799118cc1..34508a68de 100644
--- a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
+++ b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
@@ -40,28 +40,15 @@ library
     DataKinds
     TypeOperators
 
-executable test-server
+test-suite tests
+  type:             exitcode-stdio-1.0
   default-language: Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-haddock-comments-plugin
-    , hls-plugin-api
-
-  main-is:          Server.hs
   hs-source-dirs:   test
-  ghc-options:      -threaded
-
-test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  build-tool-depends: hls-haddock-comments-plugin:test-server -any
-  hs-source-dirs:     test
-  main-is:            Main.hs
+  main-is:          Main.hs
   build-depends:
     , base
     , bytestring
     , filepath
+    , hls-haddock-comments-plugin
     , hls-test-utils
     , text
diff --git a/plugins/hls-haddock-comments-plugin/test/Main.hs b/plugins/hls-haddock-comments-plugin/test/Main.hs
index b1ad5d8454..5bc2817e8e 100644
--- a/plugins/hls-haddock-comments-plugin/test/Main.hs
+++ b/plugins/hls-haddock-comments-plugin/test/Main.hs
@@ -11,17 +11,21 @@ module Main
   )
 where
 
-import qualified Data.ByteString.Lazy as LBS
-import           Data.Foldable        (find)
-import           Data.Maybe           (mapMaybe)
-import           Data.Text            (Text)
-import           Data.Text.Encoding   (encodeUtf8)
-import           System.FilePath      ((<.>), (</>))
+import qualified Data.ByteString.Lazy       as LBS
+import           Data.Foldable              (find)
+import           Data.Maybe                 (mapMaybe)
+import           Data.Text                  (Text)
+import           Data.Text.Encoding         (encodeUtf8)
+import qualified Ide.Plugin.HaddockComments as HaddockComments
+import           System.FilePath            ((<.>), (</>))
 import           Test.Hls
 
 main :: IO ()
 main = defaultTestRunner tests
 
+plugin :: PluginDescriptor IdeState
+plugin = HaddockComments.descriptor "haddockComments"
+
 tests :: TestTree
 tests =
   testGroup
@@ -38,7 +42,7 @@ tests =
 
 goldenTest :: FilePath -> GenCommentsType -> Int -> Int -> TestTree
 goldenTest fp (toTitle -> expectedTitle) l c = goldenGitDiff (fp <> " (golden)") goldenFilePath $
-  runSession testCommand fullCaps haddockCommentsPath $ do
+  runSessionWithServer plugin haddockCommentsPath $ do
     doc <- openDoc hsFilePath "haskell"
     actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c))
     case find ((== Just expectedTitle) . caTitle) actions of
@@ -52,7 +56,7 @@ goldenTest fp (toTitle -> expectedTitle) l c = goldenGitDiff (fp <> " (golden)")
 
 expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree
 expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $
-  runSession testCommand fullCaps haddockCommentsPath $ do
+  runSessionWithServer plugin haddockCommentsPath $ do
     doc <- openDoc (fp <.> "hs") "haskell"
     titles <- mapMaybe caTitle <$> getCodeActions doc (Range (Position l c) (Position l $ succ c))
     liftIO $ expectedTitle `notElem` titles @? "Unexpected CodeAction"
diff --git a/plugins/hls-haddock-comments-plugin/test/Server.hs b/plugins/hls-haddock-comments-plugin/test/Server.hs
deleted file mode 100644
index 1bb10f0abd..0000000000
--- a/plugins/hls-haddock-comments-plugin/test/Server.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-
-{-# LANGUAGE OverloadedStrings #-}
-module Main(main) where
-
-import           Data.Default
-import           Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import           Ide.Plugin.Config
-import qualified Ide.Plugin.HaddockComments        as HaddockComments
-import           Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ HaddockComments.descriptor "haddockComments"
-    ] <>
-    Ghcide.descriptors
-  }
diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal
index fbefeebda2..5f705ae85d 100644
--- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal
+++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal
@@ -57,23 +57,9 @@ library
     DataKinds
     TypeOperators
 
-executable test-server
-  default-language: Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-plugin-api
-    , hls-splice-plugin
-
-  main-is:          Server.hs
-  hs-source-dirs:   test
-  ghc-options:      -threaded
-
 test-suite tests
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010
-  build-tool-depends: hls-splice-plugin:test-server -any
   hs-source-dirs:     test
   main-is:            Main.hs
   build-depends:
diff --git a/plugins/hls-splice-plugin/test/Main.hs b/plugins/hls-splice-plugin/test/Main.hs
index 53cc62ed88..517fafa7a5 100644
--- a/plugins/hls-splice-plugin/test/Main.hs
+++ b/plugins/hls-splice-plugin/test/Main.hs
@@ -13,6 +13,7 @@ import           Data.List               (find)
 import           Data.Text               (Text)
 import qualified Data.Text               as T
 import qualified Data.Text.IO            as T
+import qualified Ide.Plugin.Splice       as Splice
 import           Ide.Plugin.Splice.Types
 import           System.Directory
 import           System.FilePath
@@ -22,6 +23,9 @@ import           Test.Hls
 main :: IO ()
 main = defaultTestRunner tests
 
+plugin :: PluginDescriptor IdeState
+plugin = Splice.descriptor "splice"
+
 tests :: TestTree
 tests =
     testGroup
@@ -64,7 +68,7 @@ tests =
 goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
 goldenTest input tc line col =
     testCase (input <> " (golden)") $ do
-        runSession testCommand fullCaps spliceTestPath $ do
+        runSessionWithServer plugin spliceTestPath $ do
             doc <- openDoc input "haskell"
             _ <- waitForDiagnostics
             actions <- getCodeActions doc $ pointRange line col
@@ -73,7 +77,7 @@ goldenTest input tc line col =
                     executeCommand c
                     _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)
                     edited <- documentContents doc
-                    let expected_name = spliceTestPath </> input <.> "expected"
+                    let expected_name = input <.> "expected"
                     -- Write golden tests if they don't already exist
                     liftIO $
                         (doesFileExist expected_name >>=) $
@@ -86,7 +90,7 @@ goldenTest input tc line col =
 goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
 goldenTestWithEdit input tc line col =
     testCase (input <> " (golden)") $ do
-        runSession testCommand fullCaps spliceTestPath $ do
+        runSessionWithServer plugin spliceTestPath $ do
             doc <- openDoc input "haskell"
             orig <- documentContents doc
             let lns = T.lines orig
@@ -96,7 +100,7 @@ goldenTestWithEdit input tc line col =
                         , _end = Position (length lns + 1) 1
                         }
             liftIO $ sleep 3
-            alt <- liftIO $ T.readFile (spliceTestPath </> input <.> "error")
+            alt <- liftIO $ T.readFile (input <.> "error")
             void $ applyEdit doc $ TextEdit theRange alt
             changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt]
             void waitForDiagnostics
@@ -106,7 +110,7 @@ goldenTestWithEdit input tc line col =
                     executeCommand c
                     _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)
                     edited <- documentContents doc
-                    let expected_name = spliceTestPath </> input <.> "expected"
+                    let expected_name = input <.> "expected"
                     -- Write golden tests if they don't already exist
                     liftIO $
                         (doesFileExist expected_name >>=) $
diff --git a/plugins/hls-splice-plugin/test/Server.hs b/plugins/hls-splice-plugin/test/Server.hs
deleted file mode 100644
index 3bf0d1460c..0000000000
--- a/plugins/hls-splice-plugin/test/Server.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main(main) where
-
-import           Data.Default
-import           Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import           Ide.Plugin.Config
-import qualified Ide.Plugin.Splice                 as Splice
-import           Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ Splice.descriptor "splice"
-    ] <>
-    Ghcide.descriptors
-  }
diff --git a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
index 051fbe40bf..bdb52f07bc 100644
--- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
+++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
@@ -31,27 +31,14 @@ library
 
   default-language: Haskell2010
 
-executable test-server
+test-suite tests
+  type:             exitcode-stdio-1.0
   default-language: Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-plugin-api
-    , hls-stylish-haskell-plugin
-
-  main-is:          Server.hs
   hs-source-dirs:   test
-  ghc-options:      -threaded
-
-test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  build-tool-depends: hls-stylish-haskell-plugin:test-server -any
-  hs-source-dirs:     test
-  main-is:            Main.hs
+  main-is:          Main.hs
   build-depends:
     , base
     , bytestring
+    , hls-stylish-haskell-plugin
     , hls-test-utils
     , text
diff --git a/plugins/hls-stylish-haskell-plugin/test/Main.hs b/plugins/hls-stylish-haskell-plugin/test/Main.hs
index 6f0431274f..311e43172a 100644
--- a/plugins/hls-stylish-haskell-plugin/test/Main.hs
+++ b/plugins/hls-stylish-haskell-plugin/test/Main.hs
@@ -1,21 +1,25 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main(main) where
 
-import qualified Data.ByteString.Lazy         as BS
-import qualified Data.Text.Encoding           as T
-import qualified Data.Text.IO                 as T
-import Test.Hls
+import qualified Data.ByteString.Lazy      as BS
+import qualified Data.Text.Encoding        as T
+import qualified Data.Text.IO              as T
+import qualified Ide.Plugin.StylishHaskell as StylishHaskell
+import           Test.Hls
 
 main :: IO ()
 main = defaultTestRunner tests
 
+plugin :: PluginDescriptor IdeState
+plugin = StylishHaskell.descriptor "stylishHaskell"
+
 tests :: TestTree
 tests = testGroup "stylish-haskell" [
-  goldenGitDiff "formats a document" "test/testdata/StylishHaskell.formatted_document.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+  goldenGitDiff "formats a document" "test/testdata/StylishHaskell.formatted_document.hs" $ runSessionWithServerFormatter plugin "stylishHaskell" "test/testdata" $ do
       doc <- openDoc "StylishHaskell.hs" "haskell"
       formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing)
       BS.fromStrict . T.encodeUtf8 <$> documentContents doc
-  , goldenGitDiff "formats a range" "test/testdata/StylishHaskell.formatted_range.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+  , goldenGitDiff "formats a range" "test/testdata/StylishHaskell.formatted_range.hs" $ runSessionWithServerFormatter plugin "stylishHaskell" "test/testdata" $ do
       doc <- openDoc "StylishHaskell.hs" "haskell"
       formatRange doc (FormattingOptions 2 True Nothing Nothing Nothing) (Range (Position 0 0) (Position 2 21))
       BS.fromStrict . T.encodeUtf8 <$> documentContents doc
diff --git a/plugins/hls-stylish-haskell-plugin/test/Server.hs b/plugins/hls-stylish-haskell-plugin/test/Server.hs
deleted file mode 100644
index 0d3389cf69..0000000000
--- a/plugins/hls-stylish-haskell-plugin/test/Server.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main(main) where
-
-import           Data.Default
-import           Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import           Ide.Plugin.Config
-import qualified Ide.Plugin.StylishHaskell         as StylishHaskell
-import           Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ StylishHaskell.descriptor "stylish-haskell"
-    ] <>
-    Ghcide.descriptors
-  , argsDefaultHlsConfig = def { formattingProvider = "stylish-haskell" }
-  }

From 90c51873b206ce9ab55f3d85a5907e48418ed6e8 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 28 Mar 2021 12:11:04 +0800
Subject: [PATCH 02/14] Use async

---
 hls-test-utils/hls-test-utils.cabal |  1 +
 hls-test-utils/src/Test/Hls.hs      | 35 +++++++++++++----------------
 2 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal
index 7ed46638ef..cd31e55152 100644
--- a/hls-test-utils/hls-test-utils.cabal
+++ b/hls-test-utils/hls-test-utils.cabal
@@ -59,6 +59,7 @@ library
     , temporary
     , text
     , unordered-containers
+    , async
 
   ghc-options:      -Wall
 
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index a4be16e8fc..edd62bddbd 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -19,14 +19,13 @@ module Test.Hls
 where
 
 import           Control.Applicative.Combinators
-import           Control.Concurrent                (forkIO, killThread)
+import           Control.Concurrent.Async          (withAsync)
 import           Control.Exception.Base
 import           Control.Monad.IO.Class
 import           Data.ByteString.Lazy              (ByteString)
 import           Data.Default                      (def)
 import qualified Data.Text                         as T
-import           Development.IDE                   (IdeState, hDuplicateTo',
-                                                    noLogging)
+import           Development.IDE                   (IdeState, hDuplicateTo')
 import           Development.IDE.Main
 import qualified Development.IDE.Main              as Ghcide
 import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
@@ -80,7 +79,6 @@ muteStderr action = withTempFile $ \tmp ->
     h `hDuplicateTo'` stderr
     bracket_ action (hClose old) (old `hDuplicateTo'` stderr)
 
-
 -- | Host a server, and run a test session on it
 -- Note: cwd will be shifted into @root@ in @Session a@
 runSessionWithServer' ::
@@ -99,18 +97,17 @@ runSessionWithServer' plugin conf sconf caps root s = do
   (outR, outW) <- createPipe
   -- restore cwd after running the session; otherwise the path to test data will be invalid
   cwd <- getCurrentDirectory
-  threadId <-
-    forkIO $
-      Ghcide.defaultMain
-        def
-          { argsHandleIn = pure inR,
-            argsHandleOut = pure outW,
-            argsLogger = pure noLogging,
-            argsDefaultHlsConfig = conf,
-            argsIdeOptions = \config sessionLoader ->
-              let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
-               in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
-            argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
-          }
-  runSessionWithHandles inW outR sconf caps root s
-    `finally` (killThread threadId >> setCurrentDirectory cwd)
+  let server =
+        Ghcide.defaultMain
+          def
+            { argsHandleIn = pure inR,
+              argsHandleOut = pure outW,
+              argsDefaultHlsConfig = conf,
+              argsIdeOptions = \config sessionLoader ->
+                let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
+                 in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
+              argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
+            }
+  withAsync server $ \_ ->
+    runSessionWithHandles inW outR sconf caps root s
+      `finally` setCurrentDirectory cwd

From 39569a7ab7e38a26b8dcc60ef72ac62e2cedd77e Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 28 Mar 2021 12:14:17 +0800
Subject: [PATCH 03/14] Update CI

---
 .github/workflows/test.yml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index f14885198c..ee62d4c140 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -140,27 +140,27 @@ jobs:
 
       - name: Test hls-brittany-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-brittany-plugin --test-options="--rerun-update" || cabal test hls-brittany-plugin --test-options="--rerun"
+        run: cabal test hls-brittany-plugin --test-options="--rerun-update" || cabal test hls-brittany-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="--rerun"
 
       - name: Test hls-class-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-class-plugin --test-options="--rerun-update" || cabal test hls-class-plugin --test-options="--rerun"
+        run: cabal test hls-class-plugin --test-options="--rerun-update" || cabal test hls-class-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="--rerun"
 
       - name: Test hls-eval-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-eval-plugin --test-options="--rerun-update" || cabal test hls-eval-plugin --test-options="--rerun"
+        run: cabal test hls-eval-plugin --test-options="--rerun-update" || cabal test hls-eval-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="--rerun"
 
       - name: Test hls-haddock-comments-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-haddock-comments-plugin --test-options="--rerun-update" || cabal test hls-haddock-comments-plugin --test-options="--rerun"
+        run: cabal test hls-haddock-comments-plugin --test-options="--rerun-update" || cabal test hls-haddock-comments-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="--rerun"
 
       - name: Test hls-splice-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-splice-plugin --test-options="--rerun-update" || cabal test hls-splice-plugin --test-options="--rerun"
+        run: cabal test hls-splice-plugin --test-options="--rerun-update" || cabal test hls-splice-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="--rerun"
 
       - name: Test hls-stylish-haskell-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-stylish-haskell-plugin --test-options="--rerun-update" || cabal test hls-stylish-haskell-plugin --test-options="--rerun"
+        run: cabal test hls-stylish-haskell-plugin --test-options="--rerun-update" || cabal test hls-stylish-haskell-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="--rerun"
 
       - name: Test hls-tactics-plugin test suite
         if: ${{ matrix.test }}

From 847b4fc3f4666ea16c4893ee80b0fadfcda6a292 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 28 Mar 2021 12:22:58 +0800
Subject: [PATCH 04/14] Add rts options

---
 hls-test-utils/hls-test-utils.cabal           |  2 +-
 .../hls-brittany-plugin.cabal                 | 60 ++++++++++---------
 .../hls-class-plugin/hls-class-plugin.cabal   |  1 +
 plugins/hls-eval-plugin/hls-eval-plugin.cabal | 16 ++---
 .../hls-haddock-comments-plugin.cabal         |  1 +
 .../hls-splice-plugin/hls-splice-plugin.cabal | 11 ++--
 .../hls-stylish-haskell-plugin.cabal          |  1 +
 7 files changed, 50 insertions(+), 42 deletions(-)

diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal
index cd31e55152..e5731977b4 100644
--- a/hls-test-utils/hls-test-utils.cabal
+++ b/hls-test-utils/hls-test-utils.cabal
@@ -34,6 +34,7 @@ library
   hs-source-dirs:   src
   build-depends:
     , aeson
+    , async
     , base
     , blaze-markup
     , bytestring
@@ -59,7 +60,6 @@ library
     , temporary
     , text
     , unordered-containers
-    , async
 
   ghc-options:      -Wall
 
diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
index 41179da871..67d501efc5 100644
--- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
+++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
@@ -1,15 +1,17 @@
-cabal-version: 2.4
-name:          hls-brittany-plugin
-version:       1.0.0.0
-synopsis:      Integration with the Brittany code formatter
-description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
-license:       Apache-2.0
-license-file:  LICENSE
-author:        The Haskell IDE Team
-copyright:     The Haskell IDE Team
-maintainer:    alan.zimm@gmail.com
-category:      Development
-build-type:    Simple
+cabal-version:      2.4
+name:               hls-brittany-plugin
+version:            1.0.0.0
+synopsis:           Integration with the Brittany code formatter
+description:
+  Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
+
+license:            Apache-2.0
+license-file:       LICENSE
+author:             The Haskell IDE Team
+copyright:          The Haskell IDE Team
+maintainer:         alan.zimm@gmail.com
+category:           Development
+build-type:         Simple
 extra-source-files:
   LICENSE
   test/testdata/**/*.hs
@@ -17,28 +19,30 @@ extra-source-files:
 library
   exposed-modules:  Ide.Plugin.Brittany
   hs-source-dirs:   src
-  build-depends:    base             >=4.12 && <5
-               ,    brittany         >= 0.13.1.0
-               ,    filepath
-               ,    ghc
-               ,    ghc-boot-th
-               ,    ghcide           ^>= 1.1.0.0
-               ,    lsp-types
-               ,    hls-plugin-api   >= 1.0 && < 1.2
-               ,    lens
-               ,    text
-               ,    transformers
+  build-depends:
+    , base            >=4.12     && <5
+    , brittany        >=0.13.1.0
+    , filepath
+    , ghc
+    , ghc-boot-th
+    , ghcide          ^>=1.1.0.0
+    , hls-plugin-api  >=1.0      && <1.2
+    , lens
+    , lsp-types
+    , text
+    , transformers
 
   default-language: Haskell2010
 
 test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  hs-source-dirs: test
-  main-is: Main.hs
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
     , bytestring
     , hls-brittany-plugin
-    , text
     , hls-test-utils
+    , text
diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal
index 9d651983c5..9c6db93102 100644
--- a/plugins/hls-class-plugin/hls-class-plugin.cabal
+++ b/plugins/hls-class-plugin/hls-class-plugin.cabal
@@ -50,6 +50,7 @@ test-suite tests
   default-language: Haskell2010
   hs-source-dirs:   test
   main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
     , bytestring
diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
index e98772fb66..5029bc93f3 100644
--- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal
+++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -19,11 +19,11 @@ build-type:         Simple
 extra-source-files:
   LICENSE
   README.md
-  test/testdata/*.yaml
-  test/testdata/*.hs
+  test/testdata/*.cabal
   test/testdata/*.expected
+  test/testdata/*.hs
   test/testdata/*.lhs
-  test/testdata/*.cabal
+  test/testdata/*.yaml
 
 flag pedantic
   description: Enable -Werror
@@ -93,11 +93,11 @@ library
     TypeOperators
 
 test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  hs-source-dirs:     test
-  main-is:            Main.hs
-
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , aeson
     , base
diff --git a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
index 34508a68de..38ed623ec5 100644
--- a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
+++ b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal
@@ -45,6 +45,7 @@ test-suite tests
   default-language: Haskell2010
   hs-source-dirs:   test
   main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
     , bytestring
diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal
index 5f705ae85d..5020d55b0d 100644
--- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal
+++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal
@@ -19,8 +19,8 @@ category:           Development
 build-type:         Simple
 extra-source-files:
   LICENSE
-  test/testdata/*.expected
   test/testdata/*.error
+  test/testdata/*.expected
   test/testdata/*.hs
   test/testdata/*.yaml
 
@@ -58,10 +58,11 @@ library
     TypeOperators
 
 test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  hs-source-dirs:     test
-  main-is:            Main.hs
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
     , directory
diff --git a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
index bdb52f07bc..0ce04597da 100644
--- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
+++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal
@@ -36,6 +36,7 @@ test-suite tests
   default-language: Haskell2010
   hs-source-dirs:   test
   main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
     , bytestring

From 478fa77de9c0b5cfc1710cf2896a5fb43f5fa8f4 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 28 Mar 2021 14:55:19 +0800
Subject: [PATCH 05/14] Sleep 0.5s after running a session

---
 hls-test-utils/src/Test/Hls.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index edd62bddbd..d3213aa5f7 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -42,6 +42,7 @@ import           System.Directory                  (getCurrentDirectory,
                                                     setCurrentDirectory)
 import           System.IO.Extra
 import           System.Process.Extra              (createPipe)
+import           System.Time.Extra
 import           Test.Hls.Util
 import           Test.Tasty                        hiding (Timeout)
 import           Test.Tasty.ExpectedFailure
@@ -108,6 +109,8 @@ runSessionWithServer' plugin conf sconf caps root s = do
                  in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
               argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
             }
-  withAsync server $ \_ ->
+  x <- withAsync server $ \_ ->
     runSessionWithHandles inW outR sconf caps root s
       `finally` setCurrentDirectory cwd
+  sleep 0.5
+  pure x

From 88d340ac41ca713b9bf2add2665a217a2f0bd5c8 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 28 Mar 2021 15:34:42 +0800
Subject: [PATCH 06/14] Update CI

---
 .github/workflows/test.yml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index ee62d4c140..f046582817 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -140,27 +140,27 @@ jobs:
 
       - name: Test hls-brittany-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-brittany-plugin --test-options="--rerun-update" || cabal test hls-brittany-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="--rerun"
+        run: cabal test hls-brittany-plugin --test-options="-j1 --rerun-update" || cabal test hls-brittany-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="-j1 --rerun"
 
       - name: Test hls-class-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-class-plugin --test-options="--rerun-update" || cabal test hls-class-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="--rerun"
+        run: cabal test hls-class-plugin --test-options="-j1 --rerun-update" || cabal test hls-class-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="-j1 --rerun"
 
       - name: Test hls-eval-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-eval-plugin --test-options="--rerun-update" || cabal test hls-eval-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="--rerun"
+        run: cabal test hls-eval-plugin --test-options="-j1 --rerun-update" || cabal test hls-eval-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="-j1 --rerun"
 
       - name: Test hls-haddock-comments-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-haddock-comments-plugin --test-options="--rerun-update" || cabal test hls-haddock-comments-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="--rerun"
+        run: cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun-update" || cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun"
 
       - name: Test hls-splice-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-splice-plugin --test-options="--rerun-update" || cabal test hls-splice-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="--rerun"
+        run: cabal test hls-splice-plugin --test-options="-j1 --rerun-update" || cabal test hls-splice-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="-j1 --rerun"
 
       - name: Test hls-stylish-haskell-plugin
         if: ${{ matrix.test }}
-        run: cabal test hls-stylish-haskell-plugin --test-options="--rerun-update" || cabal test hls-stylish-haskell-plugin --test-options="--rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="--rerun"
+        run: cabal test hls-stylish-haskell-plugin --test-options="-j1 --rerun-update" || cabal test hls-stylish-haskell-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="-j1 --rerun"
 
       - name: Test hls-tactics-plugin test suite
         if: ${{ matrix.test }}

From c711388004074aa27f6a0d25c0785a786a09f1ff Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Mon, 29 Mar 2021 10:46:19 +0800
Subject: [PATCH 07/14] Don't use withAsync

---
 cabal.project                  |  4 ---
 hls-test-utils/src/Test/Hls.hs | 48 +++++++++++++++++++---------------
 2 files changed, 27 insertions(+), 25 deletions(-)

diff --git a/cabal.project b/cabal.project
index f3b33a86bc..be4fd619e0 100644
--- a/cabal.project
+++ b/cabal.project
@@ -19,10 +19,6 @@ tests: true
 
 package *
   ghc-options: -haddock
-
-package haskell-language-server
-  test-show-details: direct
-package ghcide
   test-show-details: direct
 
 write-ghc-environment-files: never
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index d3213aa5f7..b0d5799870 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -19,7 +19,7 @@ module Test.Hls
 where
 
 import           Control.Applicative.Combinators
-import           Control.Concurrent.Async          (withAsync)
+import           Control.Concurrent.Async          (async, wait)
 import           Control.Exception.Base
 import           Control.Monad.IO.Class
 import           Data.ByteString.Lazy              (ByteString)
@@ -49,11 +49,10 @@ import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.Golden
 import           Test.Tasty.HUnit
 import           Test.Tasty.Ingredients.Rerun
-import           Test.Tasty.Runners
 
--- | Run 'defaultMainWithRerun' with -j1, and silence stderr
+-- | Run 'defaultMainWithRerun', and silence stderr
 defaultTestRunner :: TestTree -> IO ()
-defaultTestRunner = muteStderr . defaultMainWithRerun . adjustOption (const $ NumThreads 1)
+defaultTestRunner = silenceStderr . defaultMainWithRerun
 
 gitDiff :: FilePath -> FilePath -> [String]
 gitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
@@ -72,13 +71,17 @@ runSessionWithServerFormatter plugin formatter =
     def
     fullCaps
 
--- | Silence stderr, running an action
-muteStderr :: IO () -> IO ()
-muteStderr action = withTempFile $ \tmp ->
-  bracket (openFile tmp AppendMode) hClose $ \h -> do
+-- | Run an action, with stderr silenced
+silenceStderr :: IO () -> IO ()
+silenceStderr action = withTempFile $ \temp ->
+  bracket (openFile temp ReadWriteMode) hClose $ \h -> do
     old <- hDuplicate stderr
+    buf <- hGetBuffering stderr
     h `hDuplicateTo'` stderr
-    bracket_ action (hClose old) (old `hDuplicateTo'` stderr)
+    bracket_
+      action
+      (hClose old)
+      (old `hDuplicateTo'` stderr >> hSetBuffering stderr buf)
 
 -- | Host a server, and run a test session on it
 -- Note: cwd will be shifted into @root@ in @Session a@
@@ -98,19 +101,22 @@ runSessionWithServer' plugin conf sconf caps root s = do
   (outR, outW) <- createPipe
   -- restore cwd after running the session; otherwise the path to test data will be invalid
   cwd <- getCurrentDirectory
-  let server =
-        Ghcide.defaultMain
-          def
-            { argsHandleIn = pure inR,
-              argsHandleOut = pure outW,
-              argsDefaultHlsConfig = conf,
-              argsIdeOptions = \config sessionLoader ->
-                let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
-                 in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
-              argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
-            }
-  x <- withAsync server $ \_ ->
+  server <-
+    async $
+      Ghcide.defaultMain
+        def
+          { argsHandleIn = pure inR,
+            argsHandleOut = pure outW,
+            argsDefaultHlsConfig = conf,
+            argsIdeOptions = \config sessionLoader ->
+              let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
+               in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
+            argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
+          }
+
+  x <-
     runSessionWithHandles inW outR sconf caps root s
       `finally` setCurrentDirectory cwd
+  wait server
   sleep 0.5
   pure x

From b40d9237b658e3ce6e6e72cfe4df7d547c27cb40 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Tue, 30 Mar 2021 10:53:55 +0800
Subject: [PATCH 08/14] Add timeout

---
 hls-test-utils/src/Test/Hls.hs | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index b0d5799870..fa615436f3 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -25,7 +25,8 @@ import           Control.Monad.IO.Class
 import           Data.ByteString.Lazy              (ByteString)
 import           Data.Default                      (def)
 import qualified Data.Text                         as T
-import           Development.IDE                   (IdeState, hDuplicateTo')
+import           Development.IDE                   (IdeState, hDuplicateTo',
+                                                    noLogging)
 import           Development.IDE.Main
 import qualified Development.IDE.Main              as Ghcide
 import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
@@ -50,9 +51,9 @@ import           Test.Tasty.Golden
 import           Test.Tasty.HUnit
 import           Test.Tasty.Ingredients.Rerun
 
--- | Run 'defaultMainWithRerun', and silence stderr
+-- | Run 'defaultMainWithRerun', limiting each single test case running at most 10 minutes
 defaultTestRunner :: TestTree -> IO ()
-defaultTestRunner = silenceStderr . defaultMainWithRerun
+defaultTestRunner = defaultMainWithRerun . adjustOption (const $ mkTimeout 600000000)
 
 gitDiff :: FilePath -> FilePath -> [String]
 gitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
@@ -72,16 +73,16 @@ runSessionWithServerFormatter plugin formatter =
     fullCaps
 
 -- | Run an action, with stderr silenced
-silenceStderr :: IO () -> IO ()
+silenceStderr :: IO a -> IO a
 silenceStderr action = withTempFile $ \temp ->
   bracket (openFile temp ReadWriteMode) hClose $ \h -> do
     old <- hDuplicate stderr
     buf <- hGetBuffering stderr
     h `hDuplicateTo'` stderr
-    bracket_
-      action
-      (hClose old)
-      (old `hDuplicateTo'` stderr >> hSetBuffering stderr buf)
+    action `finally` do
+      old `hDuplicateTo'` stderr
+      hSetBuffering stderr buf
+      hClose old
 
 -- | Host a server, and run a test session on it
 -- Note: cwd will be shifted into @root@ in @Session a@
@@ -96,7 +97,7 @@ runSessionWithServer' ::
   FilePath ->
   Session a ->
   IO a
-runSessionWithServer' plugin conf sconf caps root s = do
+runSessionWithServer' plugin conf sconf caps root s = silenceStderr $ do
   (inR, inW) <- createPipe
   (outR, outW) <- createPipe
   -- restore cwd after running the session; otherwise the path to test data will be invalid
@@ -108,6 +109,7 @@ runSessionWithServer' plugin conf sconf caps root s = do
           { argsHandleIn = pure inR,
             argsHandleOut = pure outW,
             argsDefaultHlsConfig = conf,
+            argsLogger = pure noLogging,
             argsIdeOptions = \config sessionLoader ->
               let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
                in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
@@ -118,5 +120,5 @@ runSessionWithServer' plugin conf sconf caps root s = do
     runSessionWithHandles inW outR sconf caps root s
       `finally` setCurrentDirectory cwd
   wait server
-  sleep 0.5
+  sleep 0.3
   pure x

From e1e57d00c994c895e85fc9ccb444c6307baf3e99 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Thu, 1 Apr 2021 18:42:14 +0800
Subject: [PATCH 09/14] Cancel the server action when timeout

---
 hls-test-utils/src/Test/Hls.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index fa615436f3..8c1f9d8c53 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Test.Hls
   ( module Test.Tasty.HUnit,
     module Test.Tasty,
@@ -19,7 +20,7 @@ module Test.Hls
 where
 
 import           Control.Applicative.Combinators
-import           Control.Concurrent.Async          (async, wait)
+import           Control.Concurrent.Async          (async, cancel, wait)
 import           Control.Exception.Base
 import           Control.Monad.IO.Class
 import           Data.ByteString.Lazy              (ByteString)
@@ -119,6 +120,7 @@ runSessionWithServer' plugin conf sconf caps root s = silenceStderr $ do
   x <-
     runSessionWithHandles inW outR sconf caps root s
       `finally` setCurrentDirectory cwd
-  wait server
-  sleep 0.3
+  timeout 3 (wait server) >>= \case
+    Just () -> pure ()
+    Nothing -> putStrLn "Server does not exit on time, canceling the async task..." >> cancel server
   pure x

From e2d93ef4291ebcc6980208e2f87abf9d314b6b07 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Fri, 2 Apr 2021 15:43:47 +0800
Subject: [PATCH 10/14] Fix cwd

---
 hls-test-utils/src/Test/Hls.hs | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 8c1f9d8c53..feba0da4dd 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -85,6 +85,10 @@ silenceStderr action = withTempFile $ \temp ->
       hSetBuffering stderr buf
       hClose old
 
+-- | Restore cwd after running an action
+keepCurrentDirectory :: IO a -> IO a
+keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
+
 -- | Host a server, and run a test session on it
 -- Note: cwd will be shifted into @root@ in @Session a@
 runSessionWithServer' ::
@@ -98,11 +102,9 @@ runSessionWithServer' ::
   FilePath ->
   Session a ->
   IO a
-runSessionWithServer' plugin conf sconf caps root s = silenceStderr $ do
+runSessionWithServer' plugin conf sconf caps root s = keepCurrentDirectory $ do
   (inR, inW) <- createPipe
   (outR, outW) <- createPipe
-  -- restore cwd after running the session; otherwise the path to test data will be invalid
-  cwd <- getCurrentDirectory
   server <-
     async $
       Ghcide.defaultMain
@@ -116,11 +118,12 @@ runSessionWithServer' plugin conf sconf caps root s = silenceStderr $ do
                in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
             argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
           }
-
-  x <-
-    runSessionWithHandles inW outR sconf caps root s
-      `finally` setCurrentDirectory cwd
+  x <- runSessionWithHandles inW outR sconf caps root s
   timeout 3 (wait server) >>= \case
     Just () -> pure ()
-    Nothing -> putStrLn "Server does not exit on time, canceling the async task..." >> cancel server
+    Nothing -> do
+      putStrLn "Server does not exit in 3s, canceling the async task..."
+      (t, _) <- duration $ cancel server
+      putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
+  sleep 0.1
   pure x

From ecc89c095e6168213792b9742b9baba257818aa4 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Fri, 2 Apr 2021 17:55:51 +0800
Subject: [PATCH 11/14] Close input stream manually, add a lock

---
 hls-test-utils/src/Test/Hls.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index feba0da4dd..41e4a24e76 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -21,6 +21,7 @@ where
 
 import           Control.Applicative.Combinators
 import           Control.Concurrent.Async          (async, cancel, wait)
+import           Control.Concurrent.Extra
 import           Control.Exception.Base
 import           Control.Monad.IO.Class
 import           Data.ByteString.Lazy              (ByteString)
@@ -43,6 +44,7 @@ import           Language.LSP.Types.Capabilities   (ClientCapabilities)
 import           System.Directory                  (getCurrentDirectory,
                                                     setCurrentDirectory)
 import           System.IO.Extra
+import           System.IO.Unsafe                  (unsafePerformIO)
 import           System.Process.Extra              (createPipe)
 import           System.Time.Extra
 import           Test.Hls.Util
@@ -89,6 +91,11 @@ silenceStderr action = withTempFile $ \temp ->
 keepCurrentDirectory :: IO a -> IO a
 keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
 
+{-# NOINLINE lock #-}
+-- | Never run in parallel
+lock :: Lock
+lock = unsafePerformIO newLock
+
 -- | Host a server, and run a test session on it
 -- Note: cwd will be shifted into @root@ in @Session a@
 runSessionWithServer' ::
@@ -102,7 +109,7 @@ runSessionWithServer' ::
   FilePath ->
   Session a ->
   IO a
-runSessionWithServer' plugin conf sconf caps root s = keepCurrentDirectory $ do
+runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
   (inR, inW) <- createPipe
   (outR, outW) <- createPipe
   server <-
@@ -119,11 +126,12 @@ runSessionWithServer' plugin conf sconf caps root s = keepCurrentDirectory $ do
             argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
           }
   x <- runSessionWithHandles inW outR sconf caps root s
+  hClose inW
   timeout 3 (wait server) >>= \case
     Just () -> pure ()
     Nothing -> do
       putStrLn "Server does not exit in 3s, canceling the async task..."
       (t, _) <- duration $ cancel server
       putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
-  sleep 0.1
+  sleep 0.2
   pure x

From ee3df16a2c107e7398d4704d266b274ad96ee406 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 4 Apr 2021 11:07:23 +0800
Subject: [PATCH 12/14] cleanup

---
 hls-test-utils/src/Test/Hls.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 41e4a24e76..1a8a0b97e1 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -109,7 +109,7 @@ runSessionWithServer' ::
   FilePath ->
   Session a ->
   IO a
-runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
+runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurrentDirectory $ silenceStderr $ do
   (inR, inW) <- createPipe
   (outR, outW) <- createPipe
   server <-

From 47c936dab5923d9798b7d9325438243a96654d5e Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 4 Apr 2021 14:43:18 +0800
Subject: [PATCH 13/14] tactics plugin

---
 .../hls-tactics-plugin.cabal                  | 33 ++-----------------
 plugins/hls-tactics-plugin/test/Server.hs     | 18 ----------
 plugins/hls-tactics-plugin/test/Utils.hs      | 20 +++++------
 3 files changed, 10 insertions(+), 61 deletions(-)
 delete mode 100644 plugins/hls-tactics-plugin/test/Server.hs

diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
index 357883a479..e1f051f652 100644
--- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
+++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
@@ -107,22 +107,6 @@ library
     TypeOperators,
     ViewPatterns
 
-
-executable test-server
-  default-language:   Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-tactics-plugin
-    , hls-plugin-api
-    , shake
-  main-is: Server.hs
-  hs-source-dirs: test
-  ghc-options:
-    "-with-rtsopts=-I0 -A128M"
-    -threaded -Wall -Wno-name-shadowing -Wredundant-constraints
-
 test-suite tests
   type: exitcode-stdio-1.0
   main-is: Main.hs
@@ -144,34 +128,21 @@ test-suite tests
       QuickCheck
     , aeson
     , base
-    , bytestring
-    , checkers
     , containers
-    , data-default
-    , deepseq
     , directory
     , filepath
     , ghc
     , ghcide                >= 0.7.5.0
-    , hie-bios
     , hls-plugin-api
     , hls-tactics-plugin
+    , hls-test-utils
+    , lsp-types
     , hspec
     , hspec-expectations
     , lens
-    , lsp-test
-    , lsp-types
-    , megaparsec
     , mtl
-    , tasty
-    , tasty-ant-xml           >=1.1.6
-    , tasty-expected-failure
-    , tasty-golden
-    , tasty-hunit
-    , tasty-rerun
     , text
   build-tool-depends:
       hspec-discover:hspec-discover
-    , hls-tactics-plugin:test-server -any
   default-language: Haskell2010
 
diff --git a/plugins/hls-tactics-plugin/test/Server.hs b/plugins/hls-tactics-plugin/test/Server.hs
deleted file mode 100644
index 9b1c88b5f8..0000000000
--- a/plugins/hls-tactics-plugin/test/Server.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main(main) where
-
-import           Data.Default
-import           Development.IDE.Main
-import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
-import           Ide.Plugin.Tactic                 as T
-import           Ide.PluginUtils
-
-main :: IO ()
-main = defaultMain def
-  { argsHlsPlugins = pluginDescToIdePlugins $
-    [ T.descriptor "tactics"
-    ] <>
-    Ghcide.descriptors
-  }
-
diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs
index 4dae186079..a985b78e7c 100644
--- a/plugins/hls-tactics-plugin/test/Utils.hs
+++ b/plugins/hls-tactics-plugin/test/Utils.hs
@@ -7,12 +7,10 @@
 
 module Utils where
 
-import           Control.Applicative.Combinators (skipManyTill)
 import           Control.Lens hiding (failing, (<.>), (.=))
 import           Control.Monad (unless)
 import           Control.Monad.IO.Class
 import           Data.Aeson
-import           Data.Default (Default (def))
 import           Data.Foldable
 import qualified Data.Map as M
 import           Data.Maybe
@@ -22,13 +20,15 @@ import qualified Ide.Plugin.Config as Plugin
 import           Wingman.FeatureSet (FeatureSet, allFeatures, prettyFeatureSet)
 import           Wingman.LanguageServer (mkShowMessageParams)
 import           Wingman.Types
-import           Language.LSP.Test
-import           Language.LSP.Types
 import           Language.LSP.Types.Lens hiding (actions, applyEdit, capabilities, executeCommand, id, line, message, name, rename, title)
 import           System.Directory (doesFileExist)
 import           System.FilePath
 import           Test.Hspec
+import           Test.Hls
+import           Ide.Plugin.Tactic as Tactic
 
+plugin :: PluginDescriptor IdeState
+plugin = Tactic.descriptor "tactics"
 
 ------------------------------------------------------------------------------
 -- | Get a range at the given line and column corresponding to having nothing
@@ -63,7 +63,7 @@ mkTest
          ) -- ^ A collection of (un)expected code actions.
     -> SpecWith (Arg Bool)
 mkTest name fp line col ts = it name $ do
-  runSession testCommand fullCaps tacticPath $ do
+  runSessionWithServer plugin tacticPath $ do
     setFeatureSet allFeatures
     doc <- openDoc fp "haskell"
     _ <- waitForDiagnostics
@@ -101,7 +101,7 @@ mkGoldenTest
     -> SpecWith ()
 mkGoldenTest features tc occ line col input =
   it (input <> " (golden)") $ do
-    runSession testCommand fullCaps tacticPath $ do
+    runSessionWithServer plugin tacticPath $ do
       setFeatureSet features
       doc <- openDoc input "haskell"
       _ <- waitForDiagnostics
@@ -111,7 +111,7 @@ mkGoldenTest features tc occ line col input =
       executeCommand c
       _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)
       edited <- documentContents doc
-      let expected_name = tacticPath </> input <.> "expected"
+      let expected_name = input <.> "expected"
       -- Write golden tests if they don't already exist
       liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do
         T.writeFile expected_name edited
@@ -129,7 +129,7 @@ mkShowMessageTest
     -> SpecWith ()
 mkShowMessageTest features tc occ line col input ufm =
   it (input <> " (golden)") $ do
-    runSession testCommand fullCaps tacticPath $ do
+    runSessionWithServer plugin tacticPath $ do
       setFeatureSet features
       doc <- openDoc input "haskell"
       _ <- waitForDiagnostics
@@ -155,10 +155,6 @@ tacticPath :: FilePath
 tacticPath = "test/golden"
 
 
-testCommand :: String
-testCommand = "test-server"
-
-
 executeCommandWithResp :: Command -> Session (ResponseMessage 'WorkspaceExecuteCommand)
 executeCommandWithResp cmd = do
   let args = decode $ encode $ fromJust $ cmd ^. arguments

From b354ac4cbfe047e05f9d953c6f192e74d0289fa5 Mon Sep 17 00:00:00 2001
From: Potato Hatsue <1793913507@qq.com>
Date: Sun, 4 Apr 2021 15:36:13 +0800
Subject: [PATCH 14/14] Remove sleep

---
 hls-test-utils/src/Test/Hls.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 1a8a0b97e1..9a7436bd11 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -133,5 +133,4 @@ runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurren
       putStrLn "Server does not exit in 3s, canceling the async task..."
       (t, _) <- duration $ cancel server
       putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
-  sleep 0.2
   pure x