Skip to content

Commit 084e1be

Browse files
committed
ghcide-bench: fix stderr capturing
1 parent 4de119c commit 084e1be

File tree

2 files changed

+16
-5
lines changed

2 files changed

+16
-5
lines changed

ghcide-bench/ghcide-bench.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,6 @@ description: An LSP client for running performance experiments on HLS
1313
homepage: https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme
1414
bug-reports: https://github.com/haskell/haskell-language-server/issues
1515
tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4
16-
extra-source-files: README.md
1716

1817
executable ghcide-bench
1918
default-language: Haskell2010
@@ -68,6 +67,7 @@ library
6867
Development.IDE.Test.Diagnostic
6968
build-depends:
7069
aeson,
70+
async,
7171
base == 4.*,
7272
binary,
7373
bytestring,

ghcide-bench/src/Experiments.hs

Lines changed: 15 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -24,9 +24,11 @@ module Experiments
2424
, exampleToOptions
2525
) where
2626
import Control.Applicative.Combinators (skipManyTill)
27+
import Control.Concurrent.Async (withAsync)
2728
import Control.Exception.Safe (IOException, handleAny, try)
28-
import Control.Monad.Extra (allM, forM, forM_, unless,
29-
void, whenJust, (&&^))
29+
import Control.Monad.Extra (allM, forM, forM_, forever,
30+
unless, void, when, whenJust,
31+
(&&^))
3032
import Control.Monad.Fail (MonadFail)
3133
import Control.Monad.IO.Class
3234
import Data.Aeson (Value (Null),
@@ -55,10 +57,12 @@ import Options.Applicative
5557
import System.Directory
5658
import System.Environment.Blank (getEnv)
5759
import System.FilePath ((<.>), (</>))
60+
import System.IO
5861
import System.Process
5962
import System.Time.Extra
6063
import Text.ParserCombinators.ReadP (readP_to_S)
6164
import Text.Printf
65+
6266
charEdit :: Position -> TextDocumentContentChangeEvent
6367
charEdit p =
6468
TextDocumentContentChangeEvent
@@ -341,8 +345,15 @@ runBenchmarksFun dir allBenchmarks = do
341345
}
342346
results <- forM benchmarks $ \b@Bench{name} -> do
343347
let p = (proc (ghcide ?config) (allArgs name dir))
344-
{ std_in = CreatePipe, std_out = CreatePipe }
345-
run sess = withCreateProcess p $ \(Just inH) (Just outH) _errH _pH ->
348+
{ std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
349+
run sess = withCreateProcess p $ \(Just inH) (Just outH) (Just errH) _pH -> do
350+
-- Need to continuously consume to stderr else it gets blocked
351+
-- Can't pass NoStream either to std_err
352+
hSetBuffering errH NoBuffering
353+
hSetBinaryMode errH True
354+
let errSinkThread =
355+
forever $ hGetLine errH >>= when (verbose ?config). putStrLn
356+
withAsync errSinkThread $ \_ -> do
346357
runSessionWithHandles inH outH conf lspTestCaps dir sess
347358
(b,) <$> runBench run b
348359

0 commit comments

Comments
 (0)