From e38c59dfde89f15c61b4073dcd19b53dfe440e74 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 21 Nov 2013 02:20:19 -0400
Subject: combine test program into git-repair

---
 git-repair-test.hs | 126 -----------------------------------------------------
 1 file changed, 126 deletions(-)
 delete mode 100644 git-repair-test.hs

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

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