sim: add stepstable

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index da67a1c75d97659f2e304391b62e7a43cfb7abcf..d052bad7636549f0679ea23193bfc389b5f32df7 100644 (file)
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -73,6 +73,7 @@ data SimState t = SimState
        , simHistory :: [SimCommand]
        , simVectorClock :: VectorClock
        , simRootDirectory :: FilePath
+       , simFailed :: Bool
        }
        deriving (Show, Read)
 
@@ -95,6 +96,7 @@ emptySimState rngseed rootdir = SimState
        , simHistory = []
        , simVectorClock = VectorClock 0
        , simRootDirectory = rootdir
+       , simFailed = False
        }
 
 -- State that can vary between different repos in the simulation.
@@ -209,6 +211,7 @@ data SimCommand
        | CommandAdd RawFilePath ByteSize [RepoName]
        | CommandAddMulti Int String ByteSize ByteSize [RepoName]
        | CommandStep Int
+       | CommandStepStable Int
        | CommandAction SimAction
        | CommandSeed Int
        | CommandPresent RepoName RawFilePath
@@ -262,13 +265,19 @@ applySimCommand (CommandPresent repo file) st _ = checkKnownRepo repo st $ \u ->
                                Right $ Right st
                        | otherwise -> missing
                (Just _, Nothing) -> missing
-               (Nothing, _) -> Left $ "Expected " ++ fromRawFilePath file
-                       ++ " to be present in " ++ fromRepoName repo 
-                       ++ ", but the simulation does not include that file."
+               (Nothing, _) -> Right $ Left $ do
+                       showLongNote $ UnquotedString $
+                               "Expected " ++ fromRawFilePath file
+                                       ++ " to be present in " ++ fromRepoName repo 
+                                       ++ ", but the simulation does not include that file."
+                       return $ st { simFailed = True }
   where
-       missing = Left $ "Expected " ++ fromRawFilePath file
-               ++ " to be present in " 
-               ++ fromRepoName repo ++ ", but it is not."
+       missing = Right $ Left $ do
+               showLongNote $ UnquotedString $
+                       "Expected " ++ fromRawFilePath file
+                               ++ " to be present in " 
+                               ++ fromRepoName repo ++ ", but it is not."
+               return $ st { simFailed = True }
 applySimCommand (CommandNotPresent repo file) st _ = checkKnownRepo repo st $ \u ->
        case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of
                (Just k, Just rst)
@@ -276,13 +285,19 @@ applySimCommand (CommandNotPresent repo file) st _ = checkKnownRepo repo st $ \u
                                Right $ Right st
                        | otherwise -> present
                (Just _, Nothing) -> present
-               (Nothing, _) -> Left $ "Expected " ++ fromRawFilePath file
-                       ++ " to not be present in " ++ fromRepoName repo 
-                       ++ ", but the simulation does not include that file."
+               (Nothing, _) -> Right $ Left $ do
+                       showLongNote $ UnquotedString $ 
+                               "Expected " ++ fromRawFilePath file
+                                       ++ " to not be present in " ++ fromRepoName repo 
+                                       ++ ", but the simulation does not include that file."
+                       return $ st { simFailed = True }
   where
-       present = Left $ "Expected " ++ fromRawFilePath file 
-               ++ " not to be present in " 
-               ++ fromRepoName repo ++ ", but it is present."
+       present = Right $ Left $ do
+               showLongNote $ UnquotedString $
+                       "Expected " ++ fromRawFilePath file 
+                       ++ " not to be present in " 
+                       ++ fromRepoName repo ++ ", but it is present."
+               return $ st { simFailed = True }
 applySimCommand c@(CommandVisit repo cmdparams) st _ =
        checkKnownRepo repo st $ \u -> Right $ Left $ do
                st' <- liftIO $ updateSimRepos st
@@ -425,7 +440,9 @@ applySimCommand' (CommandAddMulti n suffix minsz maxsz repos) st repobyname =
                                n' -> applySimCommand' (CommandAddMulti n' suffix minsz maxsz repos) st'' repobyname
                Right (Left _) -> error "applySimCommand' CommandAddMulti"
 applySimCommand' (CommandStep n) st _ = 
-       Right $ Left $ handleStep n n st
+       Right $ Left $ handleStep False n n st
+applySimCommand' (CommandStepStable n) st _ = 
+       Right $ Left $ handleStep True n n st
 applySimCommand' (CommandAction act) st _ =
        case getSimActionComponents act st of
                Left err -> Left err
@@ -512,8 +529,8 @@ applySimCommand' (CommandVisit _ _) _ _ = error "applySimCommand' CommandVisit"
 applySimCommand' (CommandPresent _ _) _ _ = error "applySimCommand' CommandPresent"
 applySimCommand' (CommandNotPresent _ _) _ _ = error "applySimCommand' CommandNotPresent"
 
-handleStep :: Int -> Int -> SimState SimRepo -> Annex (SimState SimRepo)
-handleStep startn n st
+handleStep :: Bool -> Int -> Int -> SimState SimRepo -> Annex (SimState SimRepo)
+handleStep muststabilize startn n st
        | n > 0 = do
                let (st', actions) = getactions unsyncactions st
                (st'', restactions) <- runoneaction actions st'
@@ -530,14 +547,22 @@ handleStep startn n st
                                                return st''''
                                        else runrest restactions' st'''' (pred n)
                        else runrest restactions st'' (pred n)
-       | otherwise = return st
+       | otherwise = checkstabalized st
   where
        runrest actions st' n'
                | n' > 0 = do
                        (st'', restactions) <- runoneaction actions st'
                        if null restactions
-                               then handleStep startn n' st'
+                               then handleStep muststabilize startn n' st'
                                else runrest restactions st'' (pred n')
+               | otherwise = checkstabalized st'
+
+       checkstabalized st'
+               | muststabilize = do
+                       showLongNote $ UnquotedString $ 
+                               "Simulation failed to stabilize after "
+                                       ++ show startn ++ " steps."
+                       return $ st' { simFailed = True }
                | otherwise = return st'
 
        unsyncactions = 

diff --git a/Annex/Sim/File.hs b/Annex/Sim/File.hs
index dd3b54b3cfd24a624b92f56f1458395621a9677c..d4bc59c75c178d80a6bb517df8856f467150d58a 100644 (file)
--- a/Annex/Sim/File.hs
+++ b/Annex/Sim/File.hs
@@ -53,6 +53,8 @@ generateSimFile = unlines . map unwords . go
                (["addmulti", show n, suffix, showsize minsz, showsize maxsz] ++ map fromRepoName repos) : go rest
        go (CommandStep n : rest) =
                ["step", show n] : go rest
+       go (CommandStepStable n : rest) =
+               ["stepstable", show n] : go rest
        go (CommandAction act : rest) = formatAction act : go rest
        go (CommandSeed n : rest) =
                ["seed", show n] : go rest
@@ -151,6 +153,10 @@ parseSimCommand ("step":n:[]) =
        case readMaybe n of
                        Just n' -> Right $ CommandStep n'
                        Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\""
+parseSimCommand ("stepstable":n:[]) =
+       case readMaybe n of
+                       Just n' -> Right $ CommandStepStable n'
+                       Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\""
 parseSimCommand l@("action":_) = case parseSimAction l of
        Right act -> Right $ CommandAction act
        Left err -> Left err

diff --git a/Command/Sim.hs b/Command/Sim.hs
index d184d3a3b595faa147877487a1704bc027235fca..56825773215566c158d1380a81b282027cb3bbf7 100644 (file)
--- a/Command/Sim.hs
+++ b/Command/Sim.hs
@@ -42,9 +42,11 @@ seek ps = case parseSimCommand ps of
                simdir <- fromRepo gitAnnexSimDir
                liftIO (restoreSim simdir) >>= \case
                        Left err -> giveup err
-                       Right st -> 
-                               runSimCommand simcmd repobyname st
-                                       >>= liftIO . suspendSim
+                       Right st -> do
+                               st' <- runSimCommand simcmd repobyname st
+                               liftIO $ suspendSim st'
+                               when (simFailed st' && not (simFailed st)) $
+                                       giveup "Simulation had errors."
 
 start :: Maybe FilePath -> CommandSeek
 start simfile = do
@@ -68,6 +70,8 @@ start simfile = do
                let st' = recordSeed st cs
                st'' <- go st' repobyname cs
                liftIO $ suspendSim st''
+               when (simFailed st'') $
+                       giveup "Simulation had errors."
 
        go st _ [] = return st
        go st repobyname (c:cs) = do

diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn
index 24851f94ead3c3d20df1b93fd6a9d4d48e4b0c85..665e91fa63552969e2168958380b3ceb2545c5cb 100644 (file)
--- a/doc/git-annex-sim.mdwn
+++ b/doc/git-annex-sim.mdwn
@@ -196,6 +196,14 @@ as passed to "git annex sim" while a simulation is running.
   This also simulates git pull and git push being run in each repository,
   as needed in order to find additional things to do.
 
+* `stepstable N`
+
+  Run the simulation forward by this many steps, at which point it is
+  expected to have stabilized.
+
+  If the simulation does not stabilize, the command will exit with a
+  nonzero exit state.
+
 * `action repo getwanted remote`
 
   Simulate the repository getting files it wants from the remote.