Permalink
Browse files

Minor clean-ups

  • Loading branch information...
1 parent 29abdc2 commit 8c1884234528b92a83956b0fb00fe17037eec053 @tibbe committed Feb 11, 2010
Showing with 16 additions and 5 deletions.
  1. +4 −0 benchmarks/Makefile
  2. +5 −4 benchmarks/ThreadDelay.hs
  3. +7 −1 tests/Manager.hs
View
@@ -10,6 +10,10 @@ ifdef USE_GHC_IO_MANAGER
ghc-bench-flags += -DUSE_GHC_IO_MANAGER
endif
+ifdef USE_EVENTLOG
+ ghc-bench-flags += -eventlog
+endif
+
programs := dead-conn deadconn pong-server signal simple thread-delay timers
.PHONY: all
@@ -30,10 +30,11 @@ main = do
let loop :: Int -> IO ()
loop i = do
when (i < numThreads) $ do
- forkIO $ do threadDelay 1000
- a <- atomicModifyIORef ref $ \a ->
- let !b = a+1 in (b,b)
- when (a == numThreads) $ putMVar done ()
+ _ <- forkIO $ do
+ threadDelay 1000
+ a <- atomicModifyIORef ref $ \a ->
+ let !b = a+1 in (b,b)
+ when (a == numThreads) $ putMVar done ()
loop (i + 1)
loop 0
takeMVar done
View
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
module Manager (tests) where
import Control.Concurrent (forkIO)
@@ -52,8 +53,13 @@ fdPair mgr rd wr = go `finally` do c_close (fromIntegral rd)
return ()
where
go = do
+#if __GLASGOW_HASKELL__ > 611
+ setNonBlockingFD (fromIntegral rd) True
+ setNonBlockingFD (fromIntegral wr) True
+#else
setNonBlockingFD (fromIntegral rd)
setNonBlockingFD (fromIntegral wr)
+#endif
done <- newEmptyMVar
let canRead fdk evt = do
assertEqual "read fd" (keyFd fdk) rd
@@ -83,7 +89,7 @@ backendTests what = map ($what) [
]
tests :: F.Test
-tests = F.testGroup "System.Event.Manager" [ group | (available, group) <- [
+tests = F.testGroup "System.Event.Manager" [ group | (available, group) <- [
(EPoll.available, F.testGroup "EPoll" $ backendTests EPoll.new)
, (KQueue.available, F.testGroup "KQueue" $ backendTests KQueue.new)
, (Poll.available, F.testGroup "Poll" $ backendTests Poll.new)

0 comments on commit 8c18842

Please sign in to comment.