remove fsck tryharder code

It turned out to be broken, and led to failures.
6d67245728bbbc07ad1eeaf5b3c49f64c6bbcd11 was a better fix for the problem
that code tried to fix.

4 files changed, 15 insertions, 42 deletions

diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index ad92cdb..9c62ae0 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -21,8 +21,6 @@ import Git.CatFile
 import Utility.Batch
 
 import qualified Data.Set as S
-import System.Process (std_err, std_out)
-import Control.Concurrent
 
 type MissingObjects = S.Set Sha
 
@@ -38,47 +36,20 @@ type FsckResults = Maybe MissingObjects
  - look for anything in its output (both stdout and stderr) that appears
  - to be a git sha. Not all such shas are of broken objects, so ask git
  - to try to cat the object, and see if it fails.
- -
- - Some forms of corruption will crash fsck in ways that does not let it
- - output the sha of the broken object. In such a case, Nothing will be
- - returned. In this case, to find broken objects, re-run with tryharder
- - set to True. This makes fsck run in verbose mode, so it prints out
- - shas before checking them. We assume that the last sha is the one that
- - it crashed on, and it may have crashed following from eg, a commit to a
- - tree to a subtree. So, run git show on the sha, and examin the stderr
- - to find an actual bad sha.
  -}
-findBroken :: Bool -> Bool -> Repo -> IO FsckResults
-findBroken batchmode tryharder r = do
+findBroken :: Bool -> Repo -> IO FsckResults
+findBroken batchmode r = do
 	(output, fsckok) <- processTranscript command' (toCommand params') Nothing
 	let objs = findShas output
-	if fsckok || not tryharder
+	if fsckok
 		then do
 			badobjs <- findMissing objs r
 			if S.null badobjs && not fsckok
 				then return Nothing
 				else return $ Just badobjs
-		else case lastMaybe objs of
-			Nothing -> return Nothing
-			Just o -> do
-				p@(_, _, _, pid) <- createProcess $
-					( proc "git" $ toCommand $ gitCommandLine [ Param "show", Param $ show o ] r )
-					{ std_err = CreatePipe
-					, std_out = CreatePipe
-					}
-				void $ forkIO $ void $ hGetContents (stdoutHandle p)
-				objs' <- findShas <$>
-					hGetContentsStrict (stderrHandle p)
-				badobjs <- findMissing objs' r
-				ifM (checkSuccessProcess pid)
-					( if S.null badobjs
-						then return Nothing
-						else return $ Just badobjs
-					, return $ Just $ S.singleton o
-					)
-
+		else return Nothing
   where
-	(command, params) = ("git", fsckParams tryharder r)
+	(command, params) = ("git", fsckParams r)
 	(command', params')
 		| batchmode = toBatchCommand (command, params)
 		| otherwise = (command, params)
@@ -111,9 +82,9 @@ findMissing objs r = go objs [] =<< start
 findShas :: String -> [Sha]
 findShas = catMaybes . map extractSha . concat . map words . lines
 
-fsckParams :: Bool -> Repo -> [CommandParam]
-fsckParams verbose = gitCommandLine $
+fsckParams :: Repo -> [CommandParam]
+fsckParams = gitCommandLine $
 	[ Param "fsck"
 	, Param "--no-dangling"
 	, Param "--no-reflogs"
-	] ++ if verbose then [ Param "--verbose" ] else []
+	]
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 7945bcb..4ae0008 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -76,7 +76,7 @@ cleanCorruptObjects mmissing r = check mmissing
 				else return $ Just bad
 	retry oldbad = do
 		putStrLn "Re-running git fsck to see if it finds more problems."
-		v <- findBroken False True r
+		v <- findBroken False r
 		case v of
 			Nothing -> do
 				hPutStrLn stderr $ unwords
@@ -474,7 +474,7 @@ runRepair :: Bool -> Repo -> IO (Bool, MissingObjects, [Branch])
 runRepair forced g = do
 	preRepair g
 	putStrLn "Running git fsck ..."
-	fsckresult <- findBroken False False g
+	fsckresult <- findBroken False g
 	if foundBroken fsckresult
 		then runRepairOf fsckresult forced Nothing g
 		else do
@@ -508,7 +508,7 @@ runRepairOf fsckresult forced referencerepo g = do
 		Nothing
 			| forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g)
 				( do
-					fsckresult' <- findBroken False False g
+					fsckresult' <- findBroken False g
 					case fsckresult' of
 						Nothing -> do
 							putStrLn "Unable to fully recover; cannot find missing objects."
@@ -556,7 +556,7 @@ runRepairOf fsckresult forced referencerepo g = do
 		nukeIndex g
 		-- The corrupted index can prevent fsck from finding other
 		-- problems, so re-run repair.
-		fsckresult' <- findBroken False False g
+		fsckresult' <- findBroken False g
 		result <- runRepairOf fsckresult' forced referencerepo g
 		putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate."
 		return result
diff --git a/debian/changelog b/debian/changelog
index cdba88a..9238510 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -10,6 +10,8 @@ git-repair (1.20131119) UNRELEASED; urgency=low
   * Improve fsck code to find badly corrupted objects that crash git fsck
     before it can complain about them.
   * Fixed crashes on bad file encodings.
+  * Can now run 1000 tests (./test-runner . --stop-on-failure -n 1000 --force)
+    with 0 failures.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 19 Nov 2013 17:16:56 -0400
 
diff --git a/test-runner.hs b/test-runner.hs
index c0aafb0..e81fc90 100644
--- a/test-runner.hs
+++ b/test-runner.hs
@@ -91,7 +91,7 @@ runTest settings damage = withTmpDir "tmprepo" $ \tmpdir -> do
 	case repairstatus of
 		Just True -> TestResult damage repairstatus 
 			. Just . not . Git.Fsck.foundBroken
-			<$> Git.Fsck.findBroken False False g
+			<$> Git.Fsck.findBroken False g
 		_ -> return $ TestResult damage repairstatus Nothing
 
 data TestResult = TestResult