test: for n replication
authorMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 5 Aug 2015 12:38:36 +0000 (14:38 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 5 Aug 2015 12:38:36 +0000 (14:38 +0200)
acid-state-dist.cabal
test/NReplication.hs [new file with mode: 0644]

index 9740067..c912688 100644 (file)
@@ -141,6 +141,15 @@ test-suite OrderingRandom
   build-depends:    base, directory, mtl, random,
                     safecopy, acid-state, acid-state-dist
 
+test-suite NReplication
+  main-is:          NReplication.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  ghc-options:      -Wall -threaded
+  default-language: Haskell2010
+  build-depends:    base, directory, mtl,
+                    safecopy, acid-state, acid-state-dist
+
 ----------------------------------------------------------------------
 -- Benchmarks
 benchmark Local
diff --git a/test/NReplication.hs b/test/NReplication.hs
new file mode 100644 (file)
index 0000000..73285bb
--- /dev/null
@@ -0,0 +1,47 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when, replicateM, void)
+import Control.Concurrent (threadDelay, forkIO)
+import System.Exit (exitSuccess, exitFailure)
+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
+
+-- actual test
+slave :: IO ()
+slave = do
+    acid <- enslaveRedStateFrom "state/NReplication/s1" "localhost" 3333 (IntState 0)
+    delaySec 2
+    val <- query acid GetState
+    closeAcidState acid
+    when (val /= 23) $ putStrLn "Slave hasn't got value." >> exitFailure
+
+main :: IO ()
+main = do
+    cleanup "state/NReplication"
+    acid <- openRedMasterStateFrom "state/NReplication/m" "127.0.0.1" 3333 2 (IntState 0)
+    void $ forkIO $ delaySec 2 >> slave
+    void $ forkIO $ update acid (SetState 23)      -- this update blocks
+    vals <- replicateM 5 $ do
+        delaySec 1
+        query acid GetState
+    closeAcidState acid
+    -- queries before the slave joined yield the old state, only after joining
+    -- the update is accepted
+    if head vals == 0 && last vals == 23
+        then exitSuccess
+        else exitFailure
+