From 91fd10bdff2889df5458dd50eab7c5bbf4d7d196 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 17 Jan 2007 09:17:02 +0000 Subject: [PATCH] fix threadDelay In "Add support for the IO manager thread" I accidentally spammed part of "Make sure the threaded threadDelay sleeps at least as long as it is asked", which is why the ThreadDelay001 test has been failing. --- GHC/Conc.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs index 466b2e7..83a4df8 100644 --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -649,7 +649,7 @@ waitForDelayEvent :: Int -> IO () waitForDelayEvent usecs = do m <- newEmptyMVar now <- getTicksOfDay - let target = now + usecs `quot` tick_usecs + target <- calculateTarget usecs atomicModifyIORef pendingDelays (\xs -> (Delay target m : xs, ())) prodServiceThread takeMVar m @@ -659,7 +659,7 @@ waitForDelayEventSTM :: Int -> IO (TVar Bool) waitForDelayEventSTM usecs = do t <- atomically $ newTVar False now <- getTicksOfDay - let target = now + usecs `quot` tick_usecs + target <- calculateTarget usecs atomicModifyIORef pendingDelays (\xs -> (DelaySTM target t : xs, ())) prodServiceThread return t -- 1.7.10.4