4
4
module Main (main ) where
5
5
6
6
import Control.Concurrent.Class.MonadSTM
7
- import Control.Monad (replicateM )
7
+ import Control.Monad (replicateM , forever )
8
8
import Control.Monad.Class.MonadAsync
9
9
import Control.Monad.Class.MonadFork
10
10
import Control.Monad.Class.MonadSay
@@ -67,6 +67,9 @@ prop_timeout_fail = timeout 1 (threadDelay 2)
67
67
prop_timeout_succeed :: forall m . MonadTimer m => m (Maybe () )
68
68
prop_timeout_succeed = timeout 2 (threadDelay 1 )
69
69
70
+ prop_timeout_race :: forall m . MonadTimer m => m (Maybe () )
71
+ prop_timeout_race = timeout 1 (threadDelay 1 )
72
+
70
73
71
74
--
72
75
-- threads, async
@@ -88,6 +91,13 @@ prop_async n = do
88
91
)
89
92
traverse_ wait threads
90
93
94
+ prop_threadDelay_bottleneck :: forall m . (MonadTimer m , MonadSay m )
95
+ => m (Maybe () )
96
+ prop_threadDelay_bottleneck =
97
+ timeout 1000000 $ do
98
+ forever $ do
99
+ threadDelay 1
100
+ say " "
91
101
92
102
main :: IO ()
93
103
main = defaultMain
@@ -117,6 +127,8 @@ main = defaultMain
117
127
whnf id (runSimOrThrow prop_timeout_fail)
118
128
, bench " succeed" $
119
129
whnf id (runSimOrThrow prop_timeout_succeed)
130
+ , bench " race" $
131
+ whnf id (runSimOrThrow prop_timeout_race)
120
132
]
121
133
]
122
134
,
@@ -127,6 +139,8 @@ main = defaultMain
127
139
whnf id (runSimOrThrow (prop_async n))
128
140
, bench " forkIO silent" $
129
141
whnf id (runSimOrThrow (prop_threads n))
142
+ , bench " threadDelay bottleneck silent" $
143
+ whnf id (runSimOrThrow prop_threadDelay_bottleneck)
130
144
, bench " async say" $
131
145
nf id ( selectTraceEventsSay
132
146
$ runSimTrace
@@ -135,6 +149,10 @@ main = defaultMain
135
149
nf id ( selectTraceEventsSay
136
150
$ runSimTrace
137
151
$ prop_threads n)
152
+ , bench " threadDelay bottleneck say" $
153
+ nf id ( selectTraceEventsSay
154
+ $ runSimTrace
155
+ $ prop_threadDelay_bottleneck)
138
156
]
139
157
, env (pure 250 ) $ \ n ->
140
158
bgroup " 250"
0 commit comments