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.
This commit is contained in:
parent
540bd5e1ab
commit
8047128591
2 changed files with 23 additions and 7 deletions
25
Annex/Sim.hs
25
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 }
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue