summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-28 12:46:07 -0400
committerJoey Hess2015-10-28 12:46:07 -0400
commit548e627789ffd07f8720275eab6ad3ec5dd9ac42 (patch)
tree4d1100a30a60e200c47002cf9872a1de418336ad
parent68dbfe1b08c9cf1d976ac84ea53817c54fcd3479 (diff)
propellor spin
-rw-r--r--src/Utility/ConcurrentOutput.hs20
1 files changed, 15 insertions, 5 deletions
diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs
index c6550b84..8cb81c61 100644
--- a/src/Utility/ConcurrentOutput.hs
+++ b/src/Utility/ConcurrentOutput.hs
@@ -31,7 +31,11 @@ data OutputHandle = OutputHandle
data Locker
= GeneralLock
- | ProcessLock P.ProcessHandle
+ | ProcessLock P.ProcessHandle String
+
+instance Show Locker where
+ show GeneralLock = "GeneralLock"
+ show (ProcessLock _ cmd) = "ProcessLock " ++ cmd
-- | A shared global variable for the OutputHandle.
{-# NOINLINE globalOutputHandle #-}
@@ -70,7 +74,7 @@ takeOutputLock' block = do
lcker <- outputLockedBy <$> getOutputHandle
v' <- tryTakeMVar lcker
case v' of
- Just (ProcessLock h) ->
+ Just orig@(ProcessLock h _) ->
-- if process has exited, lock is stale
ifM (isJust <$> P.getProcessExitCode h)
( havelock
@@ -79,7 +83,7 @@ takeOutputLock' block = do
void $ P.waitForProcess h
havelock
else do
- putMVar lcker (ProcessLock h)
+ putMVar lcker orig
return False
)
Just GeneralLock -> do
@@ -164,7 +168,9 @@ createProcessConcurrent p
hPutStrLn stderr "IS NOT CONCURRENT"
firstprocess
, do
- hPutStrLn stderr "IS CONCURRENT"
+ lcker <- outputLockedBy <$> getOutputHandle
+ l <- readMVar lcker
+ hPutStrLn stderr $ show ("IS CONCURRENT", l)
concurrentprocess
)
| otherwise = P.createProcess p
@@ -176,10 +182,14 @@ createProcessConcurrent p
| willoutput str = P.UseHandle h
| otherwise = str
+ cmd = case P.cmdspec p of
+ P.ShellCommand s -> s
+ P.RawCommand c ps -> unwords (c:ps)
+
firstprocess = do
r@(_, _, _, h) <- P.createProcess p
`onException` dropOutputLock
- updateOutputLocker (ProcessLock h)
+ updateOutputLocker (ProcessLock h cmd)
-- Output lock is still held as we return; the process
-- is running now, and once it exits the output lock will
-- be stale and can then be taken by something else.