Skip to content

Commit c37c2a2

Browse files
pepeiborrapepeiborra
committed
Attemp to fix failures in hls-rename-plugin test suite
The tests run all in parallel on the same workspace, and most of the modules have the same module name Main. Result: parallel writes to the same .hie files in the local tmp folder that lead to IO errors in Windows
1 parent c3ce8a4 commit c37c2a2

File tree

2 files changed

+77
-40
lines changed

2 files changed

+77
-40
lines changed

‎hls-test-utils/hls-test-utils.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ library
5050
, lsp ^>=1.2
5151
, lsp-test ^>=0.14
5252
, lsp-types >=1.2 && <1.4
53+
, shake
5354
, tasty
5455
, tasty-expected-failure
5556
, tasty-golden

‎hls-test-utils/src/Test/Hls.hs

Lines changed: 76 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -27,45 +27,52 @@ module Test.Hls
2727
where
2828

2929
import Control.Applicative.Combinators
30-
import Control.Concurrent.Async (async, cancel, wait)
30+
import Control.Concurrent.Async (async, cancel, wait)
3131
import Control.Concurrent.Extra
3232
import Control.Exception.Base
33-
import Control.Monad (unless, void)
33+
import Control.Monad (unless, void)
3434
import Control.Monad.IO.Class
35-
import Data.Aeson (Value (Null), toJSON)
36-
import Data.ByteString.Lazy (ByteString)
37-
import Data.Default (def)
38-
import qualified Data.Text as T
39-
import qualified Data.Text.Lazy as TL
40-
import qualified Data.Text.Lazy.Encoding as TL
41-
import Development.IDE (IdeState, hDuplicateTo',
42-
noLogging)
43-
import Development.IDE.Graph (ShakeOptions (shakeThreads))
35+
import Data.Aeson (Value (Null), toJSON)
36+
import Data.ByteString.Lazy (ByteString)
37+
import Data.Default (def)
38+
import Data.Foldable (for_)
39+
import qualified Data.Text as T
40+
import qualified Data.Text.Lazy as TL
41+
import qualified Data.Text.Lazy.Encoding as TL
42+
import Development.IDE (IdeState, hDuplicateTo',
43+
noLogging)
44+
import Development.IDE.Graph (ShakeOptions (shakeThreads))
4445
import Development.IDE.Main
45-
import qualified Development.IDE.Main as Ghcide
46-
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
47-
import Development.IDE.Plugin.Test (TestRequest (WaitForShakeQueue))
46+
import qualified Development.IDE.Main as Ghcide
47+
import Development.IDE.Plugin.Test (TestRequest (WaitForShakeQueue))
4848
import Development.IDE.Types.Options
49+
import Development.Shake (getDirectoryFilesIO)
4950
import GHC.IO.Handle
50-
import Ide.Plugin.Config (Config, formattingProvider)
51-
import Ide.PluginUtils (idePluginsToPluginDesc,
52-
pluginDescToIdePlugins)
51+
import Ide.Plugin.Config (Config, formattingProvider)
52+
import Ide.PluginUtils (idePluginsToPluginDesc,
53+
pluginDescToIdePlugins)
5354
import Ide.Types
5455
import Language.LSP.Test
55-
import Language.LSP.Types hiding
56-
(SemanticTokenAbsolute (length, line),
57-
SemanticTokenRelative (length),
58-
SemanticTokensEdit (_start))
59-
import Language.LSP.Types.Capabilities (ClientCapabilities)
60-
import System.Directory (getCurrentDirectory,
61-
setCurrentDirectory)
56+
import Language.LSP.Types hiding
57+
(SemanticTokenAbsolute (length, line),
58+
SemanticTokenRelative (length),
59+
SemanticTokensEdit (_start))
60+
import Language.LSP.Types.Capabilities (ClientCapabilities)
61+
import System.Directory (canonicalizePath, copyFile,
62+
createDirectoryIfMissing,
63+
getCurrentDirectory,
64+
setCurrentDirectory)
65+
import System.Environment.Blank (getEnvDefault)
6266
import System.FilePath
63-
import System.IO.Extra
64-
import System.IO.Unsafe (unsafePerformIO)
65-
import System.Process.Extra (createPipe)
67+
import System.IO.Extra (IOMode (ReadWriteMode),
68+
openFile, stderr,
69+
withTempFile)
70+
import qualified System.IO.Extra as IO
71+
import System.IO.Unsafe (unsafePerformIO)
72+
import System.Process.Extra (createPipe)
6673
import System.Time.Extra
6774
import Test.Hls.Util
68-
import Test.Tasty hiding (Timeout)
75+
import Test.Tasty hiding (Timeout)
6976
import Test.Tasty.ExpectedFailure
7077
import Test.Tasty.Golden
7178
import Test.Tasty.HUnit
@@ -111,8 +118,9 @@ goldenWithHaskellDocFormatter
111118
-> (TextDocumentIdentifier -> Session ())
112119
-> TestTree
113120
goldenWithHaskellDocFormatter plugin formatter title testDataDir path desc ext act =
114-
goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
115-
$ runSessionWithServerFormatter plugin formatter testDataDir
121+
goldenGitDiff title (testDataDir </> path <.> desc <.> ext) $
122+
runWithExtraFiles testDataDir $ \dir ->
123+
runSessionWithServerFormatter plugin formatter dir
116124
$ TL.encodeUtf8 . TL.fromStrict
117125
<$> do
118126
doc <- openDoc (path <.> ext) "haskell"
@@ -133,15 +141,19 @@ runSessionWithServerFormatter plugin formatter =
133141

134142
-- | Run an action, with stderr silenced
135143
silenceStderr :: IO a -> IO a
136-
silenceStderr action = withTempFile $ \temp ->
137-
bracket (openFile temp ReadWriteMode) hClose $ \h -> do
138-
old <- hDuplicate stderr
139-
buf <- hGetBuffering stderr
140-
h `hDuplicateTo'` stderr
141-
action `finally` do
142-
old `hDuplicateTo'` stderr
143-
hSetBuffering stderr buf
144-
hClose old
144+
silenceStderr action = do
145+
showStderr <- getEnvDefault "LSP_TEST_LOG_STDERR" "0"
146+
case showStderr of
147+
"0" -> withTempFile $ \temp ->
148+
bracket (openFile temp ReadWriteMode) hClose $ \h -> do
149+
old <- hDuplicate stderr
150+
buf <- hGetBuffering stderr
151+
h `hDuplicateTo'` stderr
152+
action `finally` do
153+
old `hDuplicateTo'` stderr
154+
hSetBuffering stderr buf
155+
hClose old
156+
_ -> action
145157

146158
-- | Restore cwd after running an action
147159
keepCurrentDirectory :: IO a -> IO a
@@ -223,5 +235,29 @@ waitForBuildQueue = do
223235
(td, resp) <- duration $ skipManyTill anyMessage $ responseForId m waitId
224236
case resp of
225237
ResponseMessage{_result=Right Null} -> return td
226-
-- assume a ghcide binary lacking the WaitForShakeQueue method
227238
_ -> return 0
239+
240+
{-£ NOINLINE cwd £-}
241+
cwd :: FilePath
242+
cwd = unsafePerformIO getCurrentDirectory
243+
244+
runWithExtraFiles :: FilePath -> (FilePath -> IO a) -> IO a
245+
runWithExtraFiles testDataDir s = withTempDir $ \dir -> do
246+
copyTestDataFiles (cwd </> testDataDir) dir
247+
s dir
248+
249+
-- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path
250+
-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
251+
-- @/var@
252+
withTempDir :: (FilePath -> IO a) -> IO a
253+
withTempDir f = IO.withTempDir $ \dir -> do
254+
dir' <- canonicalizePath dir
255+
f dir'
256+
257+
copyTestDataFiles :: FilePath -> FilePath -> IO ()
258+
copyTestDataFiles testDataDir dir = do
259+
-- Copy all the test data files to the temporary workspace
260+
testDataFiles <- getDirectoryFilesIO testDataDir ["//*"]
261+
for_ testDataFiles $ \f -> do
262+
createDirectoryIfMissing True $ dir </> takeDirectory f
263+
copyFile (testDataDir </> f) (dir </> f)

0 commit comments

Comments
 (0)