From f6687e4a7c7abaddab15f667051ce21dabe2427b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 21 Nov 2013 01:52:49 -0400 Subject: rename --- Makefile | 4 +- git-repair-test.hs | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++ git-repair.cabal | 6 +-- test-runner.hs | 126 ----------------------------------------------------- 4 files changed, 131 insertions(+), 131 deletions(-) create mode 100644 git-repair-test.hs delete mode 100644 test-runner.hs diff --git a/Makefile b/Makefile index b650760..756f686 100644 --- a/Makefile +++ b/Makefile @@ -4,7 +4,7 @@ CABAL?=cabal # set to "./Setup" if you lack a cabal program build: Build/SysConfig.hs $(CABAL) build ln -sf dist/build/git-repair/git-repair git-repair - ln -sf dist/build/test-runner/test-runner test-runner + ln -sf dist/build/git-repair-test/git-repair-test git-repair-test @$(MAKE) tags >/dev/null 2>&1 & Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs @@ -18,7 +18,7 @@ install: build install -m 0644 git-repair.1 $(DESTDIR)$(PREFIX)/share/man/man1 clean: - rm -rf git-repair test-runner test-runner.log \ + rm -rf git-repair git-repair-test git-repair-test.log \ dist configure Build/SysConfig.hs Setup tags find . -name \*.o -exec rm {} \; find . -name \*.hi -exec rm {} \; diff --git a/git-repair-test.hs b/git-repair-test.hs new file mode 100644 index 0000000..8256d31 --- /dev/null +++ b/git-repair-test.hs @@ -0,0 +1,126 @@ +{- 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" diff --git a/git-repair.cabal b/git-repair.cabal index 77150ee..ff5e964 100644 --- a/git-repair.cabal +++ b/git-repair.cabal @@ -1,5 +1,5 @@ Name: git-repair -Version: 1.20131118 +Version: 1.20131119 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess @@ -28,8 +28,8 @@ Executable git-repair if (! os(windows)) Build-Depends: unix -Executable test-runner - Main-Is: test-runner.hs +Executable git-repair-test + Main-Is: git-repair-test.hs GHC-Options: -Wall -threaded Build-Depends: MissingH, hslogger, directory, filepath, containers, mtl, network, extensible-exceptions, unix-compat, bytestring, diff --git a/test-runner.hs b/test-runner.hs deleted file mode 100644 index 56b118e..0000000 --- a/test-runner.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 test-runner.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 "test-runner - test command in corrupted git repository" - -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 = "test-runner.log" -- cgit v1.2.3