stm-delay-0.1: test/Main.hs

{-# LANGUAGE CPP #-}

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.Delay

main = trivial

trivial = do
    let new t = do
            delay <- newDelay t
            return (delay, atomically $ tryWaitDelay delay)

    -- The delay times out at the right time, and after tryWaitDelay returns
    -- 'True', 'updateDelay' and 'cancelDelay' have no observable effect.
    (delay, wait) <- new 100000
    False <- wait
    threadDelay 50000
    False <- wait
    threadDelay 60000
    True <- wait
    updateDelay delay 1000000
    True <- wait
    updateDelay delay (-1)
    True <- wait
    cancelDelay delay
    True <- wait

    (delay, wait) <- new 100000
    False <- wait
    threadDelay 50000
    False <- wait
    updateDelay delay 200000
    threadDelay 60000
    False <- wait
    threadDelay 60000
    False <- wait   -- updateDelay sets the timer based on the current time,
                    -- so the threadDelay 50000 doesn't count toward our total.
    threadDelay 81000
    True <- wait

    -- 'newDelay n' where n <= 0 times out immediately,
    -- rather than never timing out.
    (delay, wait) <- new 0
    threadDelay 100
    True <- wait
    (delay, wait) <- new (-1)
    threadDelay 100
    True <- wait

    -- This fails on Windows without -threaded, as 'threadDelay minBound'
    -- blocks.  It also fails on Linux using GHC 7.0.3 without -threaded.
#if !mingw32_HOST_OS && MIN_VERSION_base(4,4,0)
    (delay, wait) <- new minBound
    threadDelay 1000
    True <- wait
#endif

    -- 'newDelay maxBound' doesn't time out any time soon,
    -- and updateDelay doesn't wait for the delay to complete.
    --
    -- Using maxBound currently fails on Linux 64-bit (see GHC ticket #7325),
    -- so use a more lenient value for now.
    --
    -- (delay, wait) <- new maxBound
    (delay, wait) <- new 2147483647
    False <- wait
    threadDelay 100000
    False <- wait
    updateDelay delay 100000
    threadDelay 90000
    False <- wait
    threadDelay 10010
    True <- wait

    -- cancelDelay causes the delay to miss its initial deadline,
    -- and a subsequent updateDelay has no effect.
    (delay, wait) <- new 100000
    False <- wait
    threadDelay 50000
    False <- wait
    cancelDelay delay
    False <- wait
    threadDelay 60000
    False <- wait
    updateDelay delay 10000
    False <- wait
    threadDelay 20000
    False <- wait
    cancelDelay delay
    False <- wait
    threadDelay 100000
    False <- wait

    return ()