diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-23 21:05:25 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-30 20:53:55 +0200 |
commit | b2278c50bfce8d8c6f80d04822ecedf42081659d (patch) | |
tree | c8c028c20c9fa6452f5a6aefd82b05292e92fe50 /src | |
parent | 558ea4d565799aa2000af0b1fc6d159447c9868b (diff) |
Test: fully evaluate output line before taking the lock
Diffstat (limited to 'src')
-rw-r--r-- | src/Test.hs | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/src/Test.hs b/src/Test.hs index 819c97d..a506345 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -4,6 +4,7 @@ module Test ( import Control.Arrow import Control.Concurrent +import Control.Exception import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State @@ -107,9 +108,11 @@ getHead = do type Output = MVar () outLine :: Output -> String -> IO () -outLine mvar line = withMVar mvar $ \() -> do - putStrLn line - hFlush stdout +outLine mvar line = do + evaluate $ foldl' (flip seq) () line + withMVar mvar $ \() -> do + putStrLn line + hFlush stdout cmdOut :: String -> Command cmdOut line = do |