bench: Slave benchmark added
authorMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 29 Jul 2015 19:01:37 +0000 (21:01 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 29 Jul 2015 19:01:37 +0000 (21:01 +0200)
acid-state-dist.cabal
benchmark/BenchCommon.hs
benchmark/Slave.hs [new file with mode: 0644]

index c77cfe6..9740067 100644 (file)
@@ -169,3 +169,12 @@ benchmark MasterSlave
   default-language: Haskell2010
   build-depends:    base, directory, mtl, criterion,
                     safecopy, acid-state, acid-state-dist
+
+benchmark Slave
+  main-is:          Slave.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   benchmark
+  ghc-options:      -Wall -threaded
+  default-language: Haskell2010
+  build-depends:    base, directory, mtl, criterion,
+                    safecopy, acid-state, acid-state-dist
index c4c2bfd..c0b2dd9 100644 (file)
@@ -52,3 +52,9 @@ masterBench acid = replicateM_ 100 $ update acid IncrementState
 masterBenchGrouped :: AcidState IntState -> IO ()
 masterBenchGrouped acid = groupUpdates acid (replicate 100 IncrementState)
 
+slaveBench :: AcidState IntState -> IO ()
+slaveBench acid = replicateM_ 10 $ update acid IncrementState
+
+slaveBenchGrouped :: AcidState IntState -> IO ()
+slaveBenchGrouped acid = groupUpdates acid (replicate 10 IncrementState)
+
diff --git a/benchmark/Slave.hs b/benchmark/Slave.hs
new file mode 100644 (file)
index 0000000..38c68db
--- /dev/null
@@ -0,0 +1,41 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Criterion.Main
+
+import Data.Acid
+import Data.Acid.Centered
+
+import System.Exit (exitSuccess)
+import Control.Monad (void)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
+
+-- common benchmarking stuff
+import BenchCommon
+
+-- the master
+master :: MVar () -> IO ()
+master sync = do
+    acid <- openMasterStateFrom "state/Slave/m" "127.0.0.1" 3333 (IntState 0)
+    takeMVar sync
+    closeAcidState acid
+
+main :: IO ()
+main = do
+    -- init acid
+    cleanup "state/Slave"
+    sync <- newEmptyMVar
+    void $ forkIO $ master sync
+    acid <- enslaveStateFrom "state/Slave/s1" "localhost" 3333 (IntState 0)
+    delaySec 3
+
+    -- run benchmark
+    defaultMain
+        [ bench "Slave" $ nfIO (slaveBench acid)
+        , bench "Slave-grouped" $ nfIO (slaveBenchGrouped acid)
+        ]
+
+    -- cleanup
+    putMVar sync ()
+    closeAcidState acid
+    exitSuccess