Skip to content

Commit 0561523

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 0561523

File tree

2 files changed

+80
-42
lines changed

2 files changed

+80
-42
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: 79 additions & 42 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
@@ -92,8 +99,9 @@ goldenWithHaskellDoc
9299
-> TestTree
93100
goldenWithHaskellDoc plugin title testDataDir path desc ext act =
94101
goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
95-
$ runSessionWithServer plugin testDataDir
96-
$ TL.encodeUtf8 . TL.fromStrict
102+
$ runWithExtraFiles testDataDir $ \dir ->
103+
runSessionWithServer plugin dir $
104+
TL.encodeUtf8 . TL.fromStrict
97105
<$> do
98106
doc <- openDoc (path <.> ext) "haskell"
99107
void waitForBuildQueue
@@ -111,8 +119,9 @@ goldenWithHaskellDocFormatter
111119
-> (TextDocumentIdentifier -> Session ())
112120
-> TestTree
113121
goldenWithHaskellDocFormatter plugin formatter title testDataDir path desc ext act =
114-
goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
115-
$ runSessionWithServerFormatter plugin formatter testDataDir
122+
goldenGitDiff title (testDataDir </> path <.> desc <.> ext) $
123+
runWithExtraFiles testDataDir $ \dir ->
124+
runSessionWithServerFormatter plugin formatter dir
116125
$ TL.encodeUtf8 . TL.fromStrict
117126
<$> do
118127
doc <- openDoc (path <.> ext) "haskell"
@@ -133,15 +142,19 @@ runSessionWithServerFormatter plugin formatter =
133142

134143
-- | Run an action, with stderr silenced
135144
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
145+
silenceStderr action = do
146+
showStderr <- getEnvDefault "LSP_TEST_LOG_STDERR" "0"
147+
case showStderr of
148+
"0" -> withTempFile $ \temp ->
149+
bracket (openFile temp ReadWriteMode) hClose $ \h -> do
150+
old <- hDuplicate stderr
151+
buf <- hGetBuffering stderr
152+
h `hDuplicateTo'` stderr
153+
action `finally` do
154+
old `hDuplicateTo'` stderr
155+
hSetBuffering stderr buf
156+
hClose old
157+
_ -> action
145158

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

0 commit comments

Comments
 (0)