From f6687e4a7c7abaddab15f667051ce21dabe2427b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 21 Nov 2013 01:52:49 -0400
Subject: rename

---
 git-repair-test.hs | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 126 insertions(+)
 create mode 100644 git-repair-test.hs

(limited to 'git-repair-test.hs')

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"
-- 
cgit v1.2.3