summaryrefslogtreecommitdiff
path: root/git-repair-test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'git-repair-test.hs')
-rw-r--r--git-repair-test.hs126
1 files changed, 0 insertions, 126 deletions
diff --git a/git-repair-test.hs b/git-repair-test.hs
deleted file mode 100644
index 8256d31..0000000
--- a/git-repair-test.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{- Test runner
- -
- - Passed a git repository, makes a temporary clone of the git repository,
- - corrupts part of it, then tries to repair it, and logs the result.
- -}
-
-module Main where
-
-import Options.Applicative
-
-import Common
-import qualified Git.Construct
-import qualified Git.Config
-import qualified Git.Destroyer
-import qualified Git.Repair
-import qualified Git.Fsck
-import Utility.Tmp
-
-data Settings = Settings
- { originalGitRepo :: FilePath
- , forced :: Bool
- , retryMode :: Bool
- , stopOnFailure :: Bool
- , numTests :: Int
- }
-
-parseSettings :: Parser Settings
-parseSettings = Settings
- <$> argument str
- (metavar "REPO")
- <*> switch
- ( long "force"
- <> help "Force repair"
- )
- <*> switch
- ( long "retry"
- <> help "Retry tests in git-repair-test.log"
- )
- <*> switch
- ( long "stop-on-failure"
- <> help "Stop running tests on failure"
- )
- <*> option
- ( long "numtests"
- <> short 'n'
- <> metavar "N"
- <> help "Run N tests"
- <> value 1
- )
-
-main :: IO ()
-main = execParser opts >>= run
- where
- opts = info (helper <*> parseSettings) desc
- desc = fullDesc
- <> header "git-repair-test - test git-repair"
-
-run :: Settings -> IO ()
-run settings
- | retryMode settings = do
- l <- map Prelude.read . lines <$> readFile logFile
- go $ forM l $ \damage ->
- runTest settings damage >>= showTestResult settings
- | otherwise =
- go $ forM [1 .. numTests settings] $ \n -> do
- putStrLn $ "** Test " ++ show n ++ "/" ++ show (numTests settings)
- runRandomTest settings
- where
- go a = exitBool . and =<< a
-
-runRandomTest :: Settings -> IO Bool
-runRandomTest settings = do
- damage <- Git.Destroyer.generateDamage
- logDamage damage
- result <- runTest settings damage
- showTestResult settings result
-
-runTest :: Settings -> [Git.Destroyer.Damage] -> IO TestResult
-runTest settings damage = withTmpDir "tmprepo" $ \tmpdir -> do
- let cloneloc = tmpdir </> "clone"
- cloned <- boolSystem "git"
- [ Param "clone"
- , Param "--no-hardlinks"
- , File (originalGitRepo settings)
- , File cloneloc
- ]
- unless cloned $
- error $ "failed to clone " ++ originalGitRepo settings
- g <- Git.Config.read =<< Git.Construct.fromPath cloneloc
- Git.Destroyer.applyDamage damage g
- repairstatus <- catchMaybeIO $ Git.Repair.successfulRepair
- <$> Git.Repair.runRepair (forced settings) g
- case repairstatus of
- Just True -> TestResult damage repairstatus
- . Just . not . Git.Fsck.foundBroken
- <$> Git.Fsck.findBroken False g
- _ -> return $ TestResult damage repairstatus Nothing
-
-data TestResult = TestResult
- { damageList :: [Git.Destroyer.Damage]
- , repairResult :: Maybe Bool
- , fsckResult :: Maybe Bool
- }
- deriving (Read, Show)
-
-showTestResult :: Settings -> TestResult -> IO Bool
-showTestResult settings testresult = do
- ok <- case (repairResult testresult, fsckResult testresult) of
- (Just True, Just True) -> do
- putStrLn "** repair succeeded"
- return True
- (Just True, Just False) -> do
- putStrLn "** repair succeeded, but final fsck failed"
- return False
- _ -> do
- putStrLn "** repair failed"
- return False
- when (stopOnFailure settings && not ok) $
- exitFailure
- return ok
-
-logDamage :: [Git.Destroyer.Damage] -> IO ()
-logDamage damage = appendFile logFile $ show damage ++ "\n"
-
-logFile :: FilePath
-logFile = "git-repair-test.log"