[Git][ghc/ghc][master] Document that threadDelay / timeout are susceptible to overflows on 32-bit machines
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Aug 11 02:42:06 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00
Document that threadDelay / timeout are susceptible to overflows on 32-bit machines
- - - - -
8 changed files:
- libraries/base/GHC/Conc/IO.hs
- libraries/base/GHC/Conc/POSIX.hs
- libraries/base/GHC/Conc/Windows.hs
- libraries/base/GHC/Event/Thread.hs
- libraries/base/GHC/Event/TimerManager.hs
- libraries/base/GHC/Event/Windows.hsc
- libraries/base/GHC/Event/Windows/Thread.hs
- libraries/base/System/Timeout.hs
Changes:
=====================================
libraries/base/GHC/Conc/IO.hs
=====================================
@@ -189,6 +189,9 @@ closeFdWith close fd
-- when the delay has expired, but the thread will never continue to
-- run /earlier/ than specified.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+-- Consider using @Control.Concurrent.Thread.Delay.delay@ from @unbounded-delays@ package.
threadDelay :: Int -> IO ()
threadDelay time
#if defined(mingw32_HOST_OS)
@@ -206,6 +209,9 @@ threadDelay time
-- after a given number of microseconds. The caveats associated with
-- 'threadDelay' also apply.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
registerDelay :: Int -> IO (TVar Bool)
registerDelay usecs
#if defined(mingw32_HOST_OS)
=====================================
libraries/base/GHC/Conc/POSIX.hs
=====================================
@@ -107,6 +107,9 @@ asyncWriteBA fd isSock len off bufB =
-- when the delay has expired, but the thread will never continue to
-- run /earlier/ than specified.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
threadDelay :: Int -> IO ()
threadDelay time
| threaded = waitForDelayEvent time
@@ -118,6 +121,9 @@ threadDelay time
-- | Set the value of returned TVar to True after a given number of
-- microseconds. The caveats associated with threadDelay also apply.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
registerDelay :: Int -> IO (TVar Bool)
registerDelay usecs
| threaded = waitForDelayEventSTM usecs
=====================================
libraries/base/GHC/Conc/Windows.hs
=====================================
@@ -95,12 +95,18 @@ asyncWriteBA fd isSock len off bufB =
-- when the delay has expired, but the thread will never continue to
-- run /earlier/ than specified.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
threadDelay :: Int -> IO ()
threadDelay = POSIX.threadDelay <!> WINIO.threadDelay
-- | Set the value of returned TVar to True after a given number of
-- microseconds. The caveats associated with threadDelay also apply.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
registerDelay :: Int -> IO (TVar Bool)
registerDelay = POSIX.registerDelay <!> WINIO.registerDelay
=====================================
libraries/base/GHC/Event/Thread.hs
=====================================
@@ -55,6 +55,10 @@ import System.Posix.Types (Fd)
-- There is no guarantee that the thread will be rescheduled promptly
-- when the delay has expired, but the thread will never continue to
-- run /earlier/ than specified.
+--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
threadDelay :: Int -> IO ()
threadDelay usecs = mask_ $ do
mgr <- getSystemTimerManager
@@ -65,6 +69,9 @@ threadDelay usecs = mask_ $ do
-- | Set the value of returned TVar to True after a given number of
-- microseconds. The caveats associated with threadDelay also apply.
--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
registerDelay :: Int -> IO (TVar Bool)
registerDelay usecs = do
t <- atomically $ newTVar False
=====================================
libraries/base/GHC/Event/TimerManager.hs
=====================================
@@ -212,6 +212,10 @@ expirationTime us = do
-- returned 'TimeoutKey' can be used to later unregister or update the
-- timeout. The timeout is automatically unregistered after the given
-- time has passed.
+--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
registerTimeout :: TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey
registerTimeout mgr us cb = do
!key <- newUnique (emUniqueSource mgr)
@@ -231,6 +235,10 @@ unregisterTimeout mgr (TK key) =
-- | Update an active timeout to fire in the given number of
-- microseconds.
+--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
updateTimeout :: TimerManager -> TimeoutKey -> Int -> IO ()
updateTimeout mgr (TK key) us = do
expTime <- expirationTime us
=====================================
libraries/base/GHC/Event/Windows.hsc
=====================================
@@ -853,6 +853,10 @@ expirationTime mgr us = do
-- The timeout is automatically unregistered when it fires.
--
-- The 'TimeoutCallback' will not be called more than once.
+--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
{-# NOINLINE registerTimeout #-}
registerTimeout :: Manager -> Int -> TimeoutCallback -> IO TimeoutKey
registerTimeout mgr at Manager{..} uSrelTime cb = do
@@ -866,6 +870,10 @@ registerTimeout mgr at Manager{..} uSrelTime cb = do
-- | Update an active timeout to fire in the given number of seconds (from the
-- time 'updateTimeout' is called), instead of when it was going to fire.
-- This has no effect if the timeout has already fired.
+--
+-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+--
updateTimeout :: Manager -> TimeoutKey -> Seconds -> IO ()
updateTimeout mgr (TK key) relTime = do
now <- getTime (mgrClock mgr)
=====================================
libraries/base/GHC/Event/Windows/Thread.hs
=====================================
@@ -19,6 +19,8 @@ ensureIOManagerIsRunning = wakeupIOManager
interruptIOManager :: IO ()
interruptIOManager = interruptSystemManager
+-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
threadDelay :: Int -> IO ()
threadDelay usecs = mask_ $ do
m <- newEmptyIOPort
@@ -26,6 +28,8 @@ threadDelay usecs = mask_ $ do
reg <- registerTimeout mgr usecs $ writeIOPort m () >> return ()
readIOPort m `onException` unregisterTimeout mgr reg
+-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
registerDelay :: Int -> IO (TVar Bool)
registerDelay usecs = do
t <- newTVarIO False
=====================================
libraries/base/System/Timeout.hs
=====================================
@@ -58,7 +58,9 @@ instance Exception Timeout where
-- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result
-- is available before the timeout expires, @Just a@ is returned. A negative
-- timeout interval means \"wait indefinitely\". When specifying long timeouts,
--- be careful not to exceed @maxBound :: Int at .
+-- be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
+-- 2147483647 μs, less than 36 minutes.
+-- Consider using @Control.Concurrent.Timeout.timeout@ from @unbounded-delays@ package.
--
-- >>> timeout 1000000 (threadDelay 1000 *> pure "finished on time")
-- Just "finished on time"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c24b1b3a9d6a4c2f471fd7d8ec65141a8b46357
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c24b1b3a9d6a4c2f471fd7d8ec65141a8b46357
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220810/c35c3fab/attachment-0001.html>
More information about the ghc-commits
mailing list