sim: quiesce before freezing or ending

Probably a good idea for freezing, but especially I hope this fixes a
problem with git-annex sim run that caused it to sometimes crash in
removeDirectoryRecursive with directory not empty, presumably because a
thread was writing there at the same time.

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 42c3b8d4371a995cdd05e3b20fb5a6a6dd3f4047..dfae56949b1fbed1c7690d30fe44ccf6c1aee8dd 100644 (file)
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -26,6 +26,7 @@ import Annex.Startup
 import Annex.Link
 import Annex.Wanted
 import Annex.CatFile
+import Annex.Action (quiesce)
 import Logs.Group
 import Logs.Trust
 import Logs.PreferredContent
@@ -1012,12 +1013,26 @@ updateSimRepos :: SimState SimRepo -> IO (SimState SimRepo)
 updateSimRepos st = updateSimRepoStates st >>= initNewSimRepos
 
 updateSimRepoStates :: SimState SimRepo -> IO (SimState SimRepo)
-updateSimRepoStates inst = go inst (M.toList $ simRepoState inst)
+updateSimRepoStates = overSimRepoStates updateSimRepoState
+
+quiesceSim :: SimState SimRepo -> IO (SimState SimRepo)
+quiesceSim = overSimRepoStates go
+  where
+       go st sr = do
+               ((), astrd) <- Annex.run (simRepoAnnex sr) $ doQuietAction $
+                       quiesce False
+               return $ sr
+                       { simRepoAnnex = astrd
+                       , simRepoCurrState = st
+                       }
+
+overSimRepoStates :: (SimState SimRepo -> SimRepo -> IO SimRepo) -> SimState SimRepo -> IO (SimState SimRepo)
+overSimRepoStates a inst = go inst (M.toList $ simRepoState inst)
   where
        go st [] = return st
        go st ((u, rst):rest) = case simRepo rst of
                Just sr -> do
-                       sr' <- updateSimRepoState st sr
+                       sr' <- a st sr
                        let rst' = rst { simRepo = Just sr' }
                        let st' = st
                                { simRepoState = M.insert u rst'
@@ -1278,11 +1293,11 @@ suspendSim :: SimState SimRepo -> IO ()
 suspendSim st = do
        -- Update the sim repos before suspending, so that at restore time
        -- they are up-to-date.
-       st' <- updateSimRepos st
+       st' <- quiesceSim =<< updateSimRepos st
        let st'' = st'
-               { simRepoState = M.map freeze (simRepoState st)
+               { simRepoState = M.map freeze (simRepoState st')
                }
-       writeFile (simRootDirectory st </> "state") (show st'')
+       writeFile (simRootDirectory st'' </> "state") (show st'')
   where
        freeze :: SimRepoState SimRepo -> SimRepoState ()
        freeze rst = rst { simRepo = Nothing }

diff --git a/Command/Sim.hs b/Command/Sim.hs
index f14142b069a116a672dfad9b8ae2c046c7fa3276..93ae309ab68d3f05c4b7e76fff84e8dc1c5d6fd1 100644 (file)
--- a/Command/Sim.hs
+++ b/Command/Sim.hs
@@ -33,9 +33,10 @@ seek ("show":[]) = do
 seek ("run":simfile:[]) = startsim' (Just simfile) >>= cleanup
   where
        cleanup st = do 
+               st' <- liftIO $ quiesceSim st
                endsim
-               when (simFailed st) $ do
-                       showsim st
+               when (simFailed st') $ do
+                       showsim st'
                        giveup "Simulation shown above had errors."
 seek ps = case parseSimCommand ps of
        Left err -> giveup err