1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{-# LANGUAGE OverloadedStrings #-}
module Snap.Internal.Http.Server.TimeoutManager.Tests
( tests ) where
------------------------------------------------------------------------------
import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
import Control.Concurrent.Thread (forkIO, result)
import qualified Control.Exception as E
import Control.Monad (replicateM)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (isJust)
------------------------------------------------------------------------------
import qualified Snap.Internal.Http.Server.Clock as Clock
import qualified Snap.Internal.Http.Server.TimeoutManager as TM
import System.Timeout (timeout)
import Test.Framework (Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertBool, assertEqual)
------------------------------------------------------------------------------
tests :: [Test]
tests = [ testOneTimeout
, testSlowToDie
, testOneTimeoutAfterInactivity
, testCancel
, testTickle ]
------------------------------------------------------------------------------
register :: IO () -> TM.TimeoutManager -> IO TM.TimeoutThread
register m t = TM.register t "test" $
\restore -> restore (Clock.sleepSecs 9000)
`E.finally` m
------------------------------------------------------------------------------
testOneTimeout :: Test
testOneTimeout = testCase "timeout/oneTimeout" $ repeatedly $ do
mgr <- TM.initialize 1 0.1 Clock.getClockTime
oneTimeout mgr
------------------------------------------------------------------------------
testSlowToDie :: Test
testSlowToDie = testCase "timeout/slowToDie" $ repeatedly $ do
mgr <- TM.initialize 1 0.1 Clock.getClockTime
r <- newIORef False
s <- newIORef False
_ <- register (writeIORef r True >> Clock.sleepSecs 3 >> writeIORef s True) mgr
Clock.sleepSecs 1.5
readIORef r >>= assertEqual "started to die" True
readIORef s >>= assertEqual "not dead yet" False
Clock.sleepSecs 3
readIORef s >>= assertEqual "dead" True
------------------------------------------------------------------------------
testOneTimeoutAfterInactivity :: Test
testOneTimeoutAfterInactivity =
testCase "timeout/oneTimeoutAfterInactivity" $ repeatedly $ do
mgr <- TM.initialize 1 0.1 Clock.getClockTime
Clock.sleepSecs 3
oneTimeout mgr
------------------------------------------------------------------------------
repeatedly :: IO () -> IO ()
repeatedly m = dieIfTimeout $ do
results <- replicateM 40 (forkIO m) >>= sequence . map snd
mapM_ result results
------------------------------------------------------------------------------
oneTimeout :: TM.TimeoutManager -> IO ()
oneTimeout mgr = do
mv <- newEmptyMVar
_ <- register (putMVar mv ()) mgr
m <- timeout (3*seconds) $ takeMVar mv
assertBool "timeout fired" $ isJust m
Clock.sleepSecs 2
TM.stop mgr
------------------------------------------------------------------------------
testTickle :: Test
testTickle = testCase "timeout/tickle" $ repeatedly $ do
mgr <- TM.initialize 5 0.1 Clock.getClockTime
ref <- newIORef (0 :: Int)
h <- register (writeIORef ref 1) mgr
E.evaluate (length $ show h)
Clock.sleepSecs 1
b0 <- readIORef ref
assertEqual "b0" 0 b0
TM.tickle h 3
Clock.sleepSecs 1
b1 <- readIORef ref
assertEqual "b1" 0 b1
Clock.sleepSecs 5
b2 <- readIORef ref
assertEqual "b2" 1 b2
TM.stop mgr
------------------------------------------------------------------------------
testCancel :: Test
testCancel = testCase "timeout/cancel" $ repeatedly $ do
mgr <- TM.initialize 3 0.1 Clock.getClockTime
ref <- newIORef (0 :: Int)
h <- register (writeIORef ref 1) mgr
Clock.sleepSecs 1
readIORef ref >>= assertEqual "b0" 0
TM.cancel h
TM.tickle h 10 -- make sure tickle ignores cancelled times
Clock.sleepSecs 2
readIORef ref >>= assertEqual "b1" 1
Clock.sleepSecs 2
h' <- register (writeIORef ref 2) mgr
_ <- register (return ()) mgr
TM.set h' 1
Clock.sleepSecs 2
readIORef ref >>= assertEqual "b2" 2
_ <- register (writeIORef ref 3) mgr
hs <- replicateM 1000 $! register (return ()) mgr
mapM TM.cancel hs
TM.stop mgr
Clock.sleepSecs 1
readIORef ref >>= assertEqual "b3" 3
------------------------------------------------------------------------------
seconds :: Int
seconds = (10::Int) ^ (6::Int)
------------------------------------------------------------------------------
dieIfTimeout :: IO a -> IO a
dieIfTimeout m = timeout (30 * seconds) m >>= maybe (error "timeout") return
|
