From: Simon Marlow <simonmar@microsoft.com>
Date: Wed, 17 Jan 2007 09:17:02 +0000 (+0000)
Subject: fix threadDelay
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=91fd10bdff2889df5458dd50eab7c5bbf4d7d196;p=haskell-directory.git

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.
---

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