test: OrderingRandom

diff --git a/acid-state-dist.cabal b/acid-state-dist.cabal
index abbd6b1..80ba26d 100644 (file)
--- a/acid-state-dist.cabal
+++ b/acid-state-dist.cabal
@@ -111,3 +111,12 @@ test-suite CheckpointSync
   default-language: Haskell2010
   build-depends:    base, directory, mtl,
                     safecopy, acid-state, acid-state-dist
+
+test-suite OrderingRandom
+  main-is:          OrderingRandom.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  ghc-options:      -Wall -threaded
+  default-language: Haskell2010
+  build-depends:    base, directory, mtl, random,
+                    safecopy, acid-state, acid-state-dist

diff --git a/test/NcCommon.hs b/test/NcCommon.hs
new file mode 100644 (file)
index 0000000..268aac5
--- /dev/null
+++ b/test/NcCommon.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}
+
+module NcCommon where
+
+import Data.Acid
+import Data.SafeCopy
+import Data.Typeable
+
+import Control.Monad.Reader (ask)
+import Control.Monad.State (put, get)
+
+-- encapsulate some integers
+
+data NcState = NcState [Int]
+    deriving (Show, Typeable)
+
+$(deriveSafeCopy 0 'base ''NcState)
+
+-- transactions
+
+getState :: Query NcState [Int]
+getState = do
+    NcState val <- ask
+    return val
+
+ncOpState :: Int -> Update NcState ()
+ncOpState x = do
+    NcState val <- get
+    put $ NcState $ ncOp x val
+
+ncOp :: Int -> [Int] -> [Int]
+ncOp x v
+    | length v < 20 = x : v
+    | otherwise     = x : shorten
+    where shorten = reverse $ (r !! 1 - r !! 2 + r !! 3):drop 3 r
+          r = reverse v
+
+$(makeAcidic ''NcState ['getState, 'ncOpState])

diff --git a/tests/NonCommutative.hs b/test/NonCommutative.hs
similarity index 100%
rename from tests/NonCommutative.hs
rename to test/NonCommutative.hs

diff --git a/test/OrderingRandom.hs b/test/OrderingRandom.hs
new file mode 100644 (file)
index 0000000..8141b7f
--- /dev/null
+++ b/test/OrderingRandom.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when, forM_)
+import Control.Concurrent (forkIO,threadDelay)
+import Control.Concurrent.MVar
+import System.Exit (exitSuccess, exitFailure)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+import System.Random (mkStdGen, randomRs)
+
+-- state structures
+import NcCommon
+
+-- helpers
+delaySec :: Int -> IO ()
+delaySec n = threadDelay $ n*1000*1000
+
+cleanup :: FilePath -> IO ()
+cleanup path = do
+    sp <- doesDirectoryExist path
+    when sp $ removeDirectoryRecursive path
+
+-- actual test
+randRange :: (Int,Int)
+randRange = (100,100000)
+
+numRands :: Int
+numRands = 50
+
+slave :: Int ->  MVar [Int] -> MVar () -> IO ()
+slave id res done = do
+    let rs = randomRs randRange $ mkStdGen id :: [Int]
+    acid <- enslaveStateFrom ("state/OrderingRandom/s" ++ show id) "localhost" 3333 (NcState [])
+    forM_ (take numRands rs) $ \r -> do
+        threadDelay r
+        update acid $ NcOpState r
+    putMVar done ()
+    -- wait for others
+    _ <- takeMVar done
+    delaySec 1
+    val <- query acid GetState
+    putMVar res val
+    closeAcidState acid
+
+main :: IO ()
+main = do
+    cleanup "state/OrderingRandom"
+    acid <- openMasterStateFrom "state/OrderingRandom/m" "127.0.0.1" 3333 (NcState [])
+    -- start slaves
+    s1Res <- newEmptyMVar
+    s1Done <- newEmptyMVar
+    s1Tid <- forkIO $ slave 1 s1Res s1Done
+    threadDelay 1000 -- zmq-indentity could be the same if too fast
+    s2Res <- newEmptyMVar
+    s2Done <- newEmptyMVar
+    s2Tid <- forkIO $ slave 2 s2Res s2Done
+    -- manipulate state on master
+    let rs = randomRs randRange $ mkStdGen 23 :: [Int]
+    forM_ (take numRands rs) $ \r -> do
+        threadDelay r
+        update acid $ NcOpState r
+    -- wait for slaves
+    _ <- takeMVar s1Done
+    _ <- takeMVar s2Done
+    -- signal slaves done
+    putMVar s1Done ()
+    putMVar s2Done ()
+    -- collect results
+    vs1 <- takeMVar s1Res
+    vs2 <- takeMVar s2Res
+    vm <- query acid GetState
+    -- check results
+    when (vm /= vs1) exitFailure
+    when (vm /= vs2) exitFailure
+    closeAcidState acid
+    exitSuccess
+

diff --git a/test/readme.md b/test/readme.md
index 33c0cb7..ebff618 100644 (file)
--- a/test/readme.md
+++ b/test/readme.md
@@ -20,3 +20,8 @@ For diverged state the CRC check must fail (unless Checkpoints were replicated).
 A diverged state must be the same after sync-replicating a Checkpoint (i.e.
 Slave joins only after generating the checkpoint).
 
+# OrderingRandom
+
+It is essential to keep ordering of events identical on all nodes. This test
+applies a non-commutative operation on the state to check this behaviour.
+