control-event 0.1 → 0.2

raw patch · 3 files changed

+120/−2 lines, 3 files

Files

• Test/Event.hs +68/−0
• Test/TimeoutTest.hs +50/−0
• control-event.cabal +2/−2

@@ -0,0 +1,68 @@+module Main where++import Control.Concurrent+import Control.Concurrent.STM++import Data.Time.Clock.POSIX+import System.Time+import Control.Event+import GHC.Conc (unsafeIOToSTM)++import Text.Printf (printf)++singleTimeout :: Float -> IO ()+singleTimeout secs = do+  sys <- initEventSystem+  a <- atomically $ newTVar 0+  startTime <- getPOSIXTime+  now@(TOD sec picosec) <- getClockTime+  let newSec = truncate secs+      newPS  = truncate $ 10^12 * (secs - (fromIntegral newSec))+  addEvent sys (TOD (sec + newSec) (picosec + newPS)) (getPOSIXTime >>= atomically . writeTVar a)+  endTime <- atomically (do+    t <- readTVar a+    if t == 0+       then retry+       else return t)+  printf "%dms sleep took: %s\n" ((truncate $ secs * 1000) :: Int) (show (endTime - startTime))++multiTimeout :: Int -> Float -> IO ()+multiTimeout n secs = do+  sys <- initEventSystem+  a <- atomically $ newTVar n+  now@(TOD sec picosec) <- getClockTime+  startTime <- getPOSIXTime+  mapM_ (const $ addEvent sys (TOD (sec + truncate secs) picosec) (decAndPrint a)) [1..n]+  atomically (do+    n' <- readTVar a+    if n' == 0+       then return ()+       else retry )+  endTime <- getPOSIXTime+  printf "%d timeouts for %d ms took %s\n" n ((truncate $ secs * 1000) :: Int) (show $ endTime - startTime)+  where+  decAndPrint :: TVar Int -> IO ()+  decAndPrint a =+     atomically (do+          n <- readTVar a+	  writeTVar a (n - 1) )++setAndCancelTimeout :: Int -> Float -> IO ()+setAndCancelTimeout n secs = do+  sys <- initEventSystem+  a <- atomically $ newTVar (0 :: Int)+  now@(TOD sec picosec) <- getClockTime+  startTime <- getPOSIXTime+  tags <- mapM (const $ addEvent sys (TOD (sec + truncate secs) picosec) (atomically $ readTVar a >>= writeTVar a . ((+) 1))) [1..n]+  mapM (cancelEvent sys) tags+  endTime <- getPOSIXTime+  expired <- atomically $ readTVar a++  printf "Setting and killing %d timeouts for %d ms took %s and %d expired\n" n ((truncate $ secs * 1000) :: Int) (show $ endTime - startTime) expired++main = do+  sequence [singleTimeout 0, singleTimeout 0.1, singleTimeout 0.5, singleTimeout 1.0]+  sequence [multiTimeout 10 0.1, multiTimeout 100 0.1, multiTimeout 1000 0.1, multiTimeout 10000 0.1, multiTimeout 100000 0.1]+  sequence [multiTimeout 1000 0.1, multiTimeout 10000 0.1, multiTimeout 100000 0.1]+  sequence [setAndCancelTimeout 10 0.1, setAndCancelTimeout 100 0.1, setAndCancelTimeout 1000 0.1, setAndCancelTimeout 10000 0.1, setAndCancelTimeout 100000 0.1]+  return ()

@@ -0,0 +1,50 @@+module Main where++import Control.Concurrent+import Control.Concurrent.STM++import Data.Time.Clock.POSIX+import Control.Event.Timeout++import Text.Printf (printf)++singleTimeout secs = do+  a <- atomically $ newTVar 0+  startTime <- getPOSIXTime+  addTimeout secs (getPOSIXTime >>= atomically . writeTVar a)+  endTime <- atomically (do+    t <- readTVar a+    if t == 0+       then retry+       else return t)+  printf "%dms sleep took: %s\n" ((truncate $ secs * 1000) :: Int) (show (endTime - startTime))++multiTimeout :: Int -> Float -> IO ()+multiTimeout n secs = do+  a <- atomically $ newTVar n+  startTime <- getPOSIXTime+  mapM_ (const $ addTimeout secs (atomically $ readTVar a >>= writeTVar a . ((flip (-)) 1))) [1..n]+  atomically (do+    n' <- readTVar a+    if n' == 0+       then return ()+       else retry)+  endTime <- getPOSIXTime+  printf "%d timeouts for %d ms took %s\n" n ((truncate $ secs * 1000) :: Int) (show $ endTime - startTime)++setAndCancelTimeout :: Int -> Float -> IO ()+setAndCancelTimeout n secs = do+  a <- atomically $ newTVar (0 :: Int)+  startTime <- getPOSIXTime+  tags <- mapM (const $ addTimeout secs (atomically $ readTVar a >>= writeTVar a . ((+) 1))) [1..n]+  mapM (atomically . cancelTimeout) tags+  endTime <- getPOSIXTime+  expired <- atomically $ readTVar a++  printf "Setting and killing %d timeouts for %d ms took %s and %d expired\n" n ((truncate $ secs * 1000) :: Int) (show $ endTime - startTime) expired++main = do+  sequence [singleTimeout 0, singleTimeout 0.1, singleTimeout 0.5, singleTimeout 1.0]+  sequence [multiTimeout 10 0.1, multiTimeout 100 0.1, multiTimeout 1000 0.1, multiTimeout 10000 0.1, multiTimeout 100000 0.1]+  sequence [setAndCancelTimeout 10 0.1, setAndCancelTimeout 100 0.1, setAndCancelTimeout 1000 0.1, setAndCancelTimeout 10000 0.1, setAndCancelTimeout 100000 0.1]+  return ()

@@ -1,5 +1,5 @@ name:                control-event-version:             0.1+version:             0.2 synopsis:            Event scheduling system. description:         Allows scheduling and canceling of IO actions to be                      executed at a specified future time.@@ -10,7 +10,7 @@ maintainer:          Thomas.DuBuisson@gmail.com build-type:          Simple build-Depends:       base, old-time, containers >= 0.1, stm-ghc-options:         DeriveDataTypeable+extensions:          DeriveDataTypeable exposed-modules:     Control.Event, Control.Event.Timeout stability:           alpha tested-with:         GHC == 6.8.2