enhan: grouped benchmarks, less code duplication, make bench
authorMax Voit <max.voit+gtdv@with-eyes.net>
Fri, 24 Jul 2015 13:27:38 +0000 (15:27 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Fri, 24 Jul 2015 13:27:38 +0000 (15:27 +0200)
benchmark/BenchCommon.hs [moved from benchmark/IntCommon.hs with 50% similarity]
benchmark/Local.hs
benchmark/MasterOnly.hs
benchmark/MasterSlave.hs
makefile
test/OrderingRandom.hs

similarity index 50%
rename from benchmark/IntCommon.hs
rename to benchmark/BenchCommon.hs
index 928e0f2..c4c2bfd 100644 (file)
@@ -1,24 +1,26 @@
 {-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}
 
-module IntCommon where
+module BenchCommon where
 
 import Data.Acid
+import Data.Acid.Advanced (groupUpdates)
 import Data.SafeCopy
 import Data.Typeable
 
 import Control.Monad.Reader (ask)
 import Control.Monad.State (put, get)
 
+import Control.Monad (when, replicateM_)
+import Control.Concurrent (threadDelay)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 
 -- encapsulate some integers
-
 data IntState = IntState Int
     deriving (Show, Typeable)
 
 $(deriveSafeCopy 0 'base ''IntState)
 
 -- transactions
-
 setState :: Int -> Update IntState ()
 setState value = put (IntState value)
 
@@ -33,3 +35,20 @@ incrementState = do
     put (IntState (val + 1))
 
 $(makeAcidic ''IntState ['setState, 'getState, 'incrementState])
+
+-- helpers
+delaySec :: Int -> IO ()
+delaySec n = threadDelay $ n*1000*1000
+
+cleanup :: FilePath -> IO ()
+cleanup path = do
+    sp <- doesDirectoryExist path
+    when sp $ removeDirectoryRecursive path
+
+-- benchmark
+masterBench :: AcidState IntState -> IO ()
+masterBench acid = replicateM_ 100 $ update acid IncrementState
+
+masterBenchGrouped :: AcidState IntState -> IO ()
+masterBenchGrouped acid = groupUpdates acid (replicate 100 IncrementState)
+
index 4c14efd..008baf3 100644 (file)
@@ -1,26 +1,13 @@
 {-# LANGUAGE TypeFamilies #-}
 
-import Criterion
 import Criterion.Main
 
 import Data.Acid
 
-import Control.Monad (when, replicateM_)
 import System.Exit (exitSuccess)
-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 
--- state structures
-import IntCommon
-
--- helpers
-cleanup :: FilePath -> IO ()
-cleanup path = do
-    sp <- doesDirectoryExist path
-    when sp $ removeDirectoryRecursive path
-
--- benchmark
-masterBench :: AcidState IntState -> IO ()
-masterBench acid = replicateM_ 100 $ update acid IncrementState
+-- common benchmarking stuff
+import BenchCommon
 
 main :: IO ()
 main = do
@@ -31,6 +18,7 @@ main = do
     -- run benchmark
     defaultMain
         [ bench "Local" $ nfIO (masterBench acid)
+        , bench "Local-grouped" $ nfIO (masterBenchGrouped acid)
         ]
 
     -- cleanup
index 0c10104..ea727a4 100644 (file)
@@ -1,42 +1,26 @@
 {-# LANGUAGE TypeFamilies #-}
 
-import Criterion
 import Criterion.Main
 
 import Data.Acid
 import Data.Acid.Centered
 
-import Control.Monad (when, replicateM_)
-import Control.Concurrent (threadDelay)
 import System.Exit (exitSuccess)
-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 
--- state structures
-import IntCommon
-
--- helpers
-delaySec :: Int -> IO ()
-delaySec n = threadDelay $ n*1000*1000
-
-cleanup :: FilePath -> IO ()
-cleanup path = do
-    sp <- doesDirectoryExist path
-    when sp $ removeDirectoryRecursive path
-
--- benchmark
-masterBench :: AcidState IntState -> IO ()
-masterBench acid = replicateM_ 100 $ update acid IncrementState
+-- common benchmarking stuff
+import BenchCommon
 
 main :: IO ()
 main = do
     -- init acid
     cleanup "state/MasterOnly"
     acid <- openMasterStateFrom "state/MasterOnly/m" "127.0.0.1" 3333 (IntState 0)
-    delaySec 2
+    delaySec 3
 
     -- run benchmark
     defaultMain
         [ bench "MasterOnly" $ nfIO (masterBench acid)
+        , bench "MasterOnly-grouped" $ nfIO (masterBenchGrouped acid)
         ]
 
     -- cleanup
index c7526a3..88463f5 100644 (file)
@@ -1,33 +1,19 @@
 {-# LANGUAGE TypeFamilies #-}
 
-import Criterion
 import Criterion.Main
 
 import Data.Acid
 import Data.Acid.Centered
 
-import Control.Monad (void, when, replicateM_)
-import Control.Concurrent (threadDelay, forkIO)
-import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
 import System.Exit (exitSuccess)
-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
-
--- state structures
-import IntCommon
-
--- helpers
-delaySec :: Int -> IO ()
-delaySec n = threadDelay $ n*1000*1000
-
-cleanup :: FilePath -> IO ()
-cleanup path = do
-    sp <- doesDirectoryExist path
-    when sp $ removeDirectoryRecursive path
+import Control.Monad (void)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
 
--- benchmark
-masterBench :: AcidState IntState -> IO ()
-masterBench acid = replicateM_ 100 $ update acid IncrementState
+-- common benchmarking stuff
+import BenchCommon
 
+-- the slave
 slave :: MVar () -> IO ()
 slave sync = do
     acid <- enslaveStateFrom "state/MasterSlave/s1" "localhost" 3333 (IntState 0)
@@ -41,11 +27,12 @@ main = do
     acid <- openMasterStateFrom "state/MasterSlave/m" "127.0.0.1" 3333 (IntState 0)
     sync <- newEmptyMVar
     void $ forkIO $ slave sync
-    delaySec 2
+    delaySec 3
 
     -- run benchmark
     defaultMain
         [ bench "MasterSlave" $ nfIO (masterBench acid)
+        , bench "MasterSlave-grouped" $ nfIO (masterBenchGrouped acid)
         ]
 
     -- cleanup
index 849b9dd..33b7c41 100644 (file)
--- a/makefile
+++ b/makefile
@@ -3,6 +3,12 @@ all-test:
        cabal configure --enable-test --enable-benchmarks
        cabal build
        cabal test | grep --color -C 999 PASS
+       #cabal bench
+
+bench:
+       cabal clean
+       cabal configure --enable-benchmarks -f-debug
+       cabal build
        cabal bench
 
 clean-all-state:
index 0eadf7d..3ba25c5 100644 (file)
@@ -53,11 +53,11 @@ main = do
     -- start slaves
     s1Res <- newEmptyMVar
     s1Done <- newEmptyMVar
-    s1Tid <- forkIO $ slave 1 s1Res s1Done allDone
+    _ <- forkIO $ slave 1 s1Res s1Done allDone
     threadDelay 1000 -- zmq-indentity could be the same if too fast
     s2Res <- newEmptyMVar
     s2Done <- newEmptyMVar
-    s2Tid <- forkIO $ slave 2 s2Res s2Done allDone
+    _ <- forkIO $ slave 2 s2Res s2Done allDone
     -- manipulate state on master
     let rs = randomRs randRange $ mkStdGen 23 :: [Int]
     forM_ (take numRands rs) $ \r -> do