test: SyncTimeout and UpdateError
authorMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 5 Aug 2015 14:01:03 +0000 (16:01 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 5 Aug 2015 14:01:03 +0000 (16:01 +0200)
acid-state-dist.cabal
test/SyncTimeout.hs [new file with mode: 0644]
test/UpdateError.hs [new file with mode: 0644]

index c912688..ab9e3a7 100644 (file)
@@ -150,6 +150,24 @@ test-suite NReplication
   build-depends:    base, directory, mtl,
                     safecopy, acid-state, acid-state-dist
 
+test-suite UpdateError
+  main-is:          UpdateError.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
+
+test-suite SyncTimeout
+  main-is:          SyncTimeout.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/SyncTimeout.hs b/test/SyncTimeout.hs
new file mode 100644 (file)
index 0000000..35ace21
--- /dev/null
@@ -0,0 +1,38 @@
+{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when)
+import Control.Concurrent (threadDelay)
+import System.Exit (exitSuccess, exitFailure)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+import Control.Exception (catch, SomeException)
+
+-- 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 <- enslaveStateFrom "state/SyncTimeout/s1" "localhost" 3333 (IntState 0)
+    delaySec 11     -- SyncTimeout happens at 10 seconds
+    closeAcidState acid
+
+main :: IO ()
+main = do
+    cleanup "state/SyncTimeout"
+    catch slave $ \(e :: SomeException) ->
+        if show e == "Slave took too long to sync, ran into timeout."
+            then exitSuccess
+            else exitFailure
+
diff --git a/test/UpdateError.hs b/test/UpdateError.hs
new file mode 100644 (file)
index 0000000..8fe49cf
--- /dev/null
@@ -0,0 +1,51 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when, void)
+import Control.Concurrent (threadDelay, forkIO)
+import System.Exit (exitSuccess, exitFailure)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+import Control.Exception (finally)
+
+-- 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
+slave1 :: IO ()
+slave1 = do
+    acid <- enslaveStateFrom "state/UpdateError/s1" "localhost" 3333 (IntState 0)
+    delaySec 1
+    finally     -- the update fails; if not it's an error
+        (update acid (SetState (error "fail s1")) >> exitFailure)
+        (closeAcidState acid)
+
+slave2 :: IO ()
+slave2 = do
+    acid <- enslaveStateFrom "state/UpdateError/s2" "localhost" 3333 (IntState 0)
+    delaySec 1
+    finally     -- the update fails; if not it's an error
+        (update acid (error "fail s2" :: IncrementState) >> exitFailure)
+        (closeAcidState acid)
+
+main :: IO ()
+main = do
+    cleanup "state/UpdateError"
+    acid <- openMasterStateFrom "state/UpdateError/m" "127.0.0.1" 3333 (IntState 0)
+    update acid (SetState 23)
+    void $ forkIO slave1
+    void $ forkIO slave2
+    delaySec 2
+    closeAcidState acid
+    exitSuccess
+