summaryrefslogtreecommitdiff
path: root/src/System/Console/Concurrent
diff options
context:
space:
mode:
authorJoey Hess2016-03-06 15:29:12 -0400
committerJoey Hess2016-03-06 15:29:12 -0400
commit3371befc6a3fd7451c3c5c01b7c2f6efb05eedaf (patch)
tree85b17a8fa68972c102dac592adf52e841b0e6f2d /src/System/Console/Concurrent
parent5bcbb2fe3823c28a26cab0aa7af2c1c4c6e57184 (diff)
propellor spin
Diffstat (limited to 'src/System/Console/Concurrent')
-rw-r--r--src/System/Console/Concurrent/Internal.hs11
1 files changed, 7 insertions, 4 deletions
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
index ea4534fd..4f3a5e32 100644
--- a/src/System/Console/Concurrent/Internal.hs
+++ b/src/System/Console/Concurrent/Internal.hs
@@ -310,7 +310,7 @@ bgProcess p = do
asyncProcessWaiter $ void $ tryIO $ P.waitForProcess h
outbuf <- setupOutputBuffer StdOut toouth (P.std_out p) fromouth
errbuf <- setupOutputBuffer StdErr toerrh (P.std_err p) fromerrh
- void $ async $ bufferWriter [outbuf, errbuf]
+ void $ async $ bufferWriter p [outbuf, errbuf]
return (toConcurrentProcessHandle r)
where
pipe = do
@@ -402,12 +402,14 @@ unregisterOutputThread = do
--
-- If end is reached before lock is taken, instead add the command's
-- buffers to the global outputBuffer and errorBuffer.
-bufferWriter :: [(StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)] -> IO ()
-bufferWriter ts = do
+bufferWriter :: P.CreateProcess -> [(StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)] -> IO ()
+bufferWriter p ts = do
activitysig <- atomically newEmptyTMVar
worker1 <- async $ lockOutput $
ifM (atomically $ tryPutTMVar activitysig ())
- ( void $ mapConcurrently displaybuf ts
+ ( do
+ hPutStrLn stderr $ show ("bufferWriter calling displaybuf", showProc p)
+ void $ mapConcurrently displaybuf ts
, noop -- buffers already moved to global
)
worker2 <- async $ void $ globalbuf activitysig
@@ -437,6 +439,7 @@ bufferWriter ts = do
mapM_ (\(_outh, _buf, _bufsig, bufend) -> takeTMVar bufend) ts
return ok
when ok $ do
+ hPutStrLn stderr $ show ("bufferWriter saving in global buffer", showProc p)
-- add all of the command's buffered output to the
-- global output buffer, atomically
bs <- forM ts $ \(outh, buf, _bufsig, _bufend) ->