fix: No sync timeout on premature liberateState
authorMax Voit <max.voit+gtdv@with-eyes.net>
Thu, 23 Jul 2015 14:26:45 +0000 (16:26 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Thu, 23 Jul 2015 14:26:45 +0000 (16:26 +0200)
acid-state-dist.cabal
src/Data/Acid/Centered/Slave.hs

index d21ccbd..abbd6b1 100644 (file)
@@ -81,7 +81,7 @@ library
   default-language:    Haskell2010
 
   -- Switch on debugging by "-Unodebug", off by "-Dnodebug"
-  ghc-options:      -Wall -threaded -cpp -Dnodebug
+  ghc-options:      -Wall -threaded -cpp -Unodebug
 
 ----------------------------------------------------------------------
 -- Tests
index 9d4ee74..2104965 100644 (file)
@@ -178,6 +178,7 @@ onSyncDone :: (IsAcidic st, Typeable st) => SlaveState st -> Crc -> IO ()
 onSyncDone slaveState@SlaveState{..} crc = do
     localCrc <- crcOfState slaveLocalState
     if crc /= localCrc then do
+        -- TODO: this is an error
         putStrLn "Data.Acid.Centered.Slave: CRC mismatch after sync. Exiting."
         void $ forkIO $ liberateState slaveState
     else do
@@ -339,10 +340,12 @@ liberateState SlaveState{..} = do
         waitPoll 100 (withMVar slaveRequests (return . M.null))
         -- send master quit message
         sendToMaster slaveZmqSocket SlaveQuit
-        -- wait replication chan
-        debug "Waiting for repChan to empty."
-        mtid <- myThreadId
-        putMVar slaveRepThreadId mtid
+        -- wait replication chan, only if sync done
+        syncDone <- Event.isSet slaveSyncDone
+        when syncDone $ do
+            debug "Waiting for repChan to empty."
+            mtid <- myThreadId
+            putMVar slaveRepThreadId mtid
         -- kill handler threads
         debug "Killing request handler."
         withMVar slaveReqThreadId killThread