1 files changed, 26 insertions, 0 deletions
diff --git a/testsuite/tests/lib/Concurrent/ThreadDelay001.hs b/testsuite/tests/lib/Concurrent/ThreadDelay001.hs
new file mode 100644
index 0000000000..c60f997039
--- /dev/null
+++ b/testsuite/tests/lib/Concurrent/ThreadDelay001.hs
@@ -0,0 +1,26 @@
+
+-- Test that threadDelay actually sleeps for (at least) as long as we
+-- ask it
+
+module Main (main) where
+
+import Control.Concurrent
+import Control.Monad
+import System.Time
+
+main = mapM_ delay (0 : take 11 (iterate (*5) 1))
+
+delay n = do
+  tS <- getClockTime
+  threadDelay n
+  tE <- getClockTime
+
+  let req = fromIntegral n * 10 ^ (6 :: Int)
+      obs = case normalizeTimeDiff (diffClockTimes tE tS) of
+                TimeDiff 0 0 0 0 0 s ps -> 10^12 * fromIntegral s + ps
+      diff = obs - req
+      diff' :: Double
+      diff' = fromIntegral diff /  10^(12 :: Int)
+
+  when (obs < req) $ print (tS, tE, req, obs, diff, diff')
+