test: Fix threaded runtime hang.

There was one forkProcess lurking in test.hs, and that seems to be
responsible for recent buildd failures on amd64 and armhf. I was able to
reproduce it pretty easily on amd64, and even once on i386, and it was
clearly that same bad old threaded runtime hang. So removing this
forkProcess should fix it. Odd that it lurked for some months before
popping up.

2 files changed, 7 insertions, 15 deletions

diff --git a/debian/changelog b/debian/changelog
index 1470cf943..4ee022a7e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -5,6 +5,7 @@ git-annex (3.20121010) UNRELEASED; urgency=low
     Each of these has its own standard preferred content setting.
   * dead: Remove dead repository from all groups.
   * Avoid unsetting HOME when running certian git commands. Closes: #690193
+  * test: Fix threaded runtime hang.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 10 Oct 2012 12:59:25 -0400
 
diff --git a/test.hs b/test.hs
index c4c85af05..2417f681b 100644
--- a/test.hs
+++ b/test.hs
@@ -14,7 +14,6 @@ import Test.QuickCheck
 import System.Posix.Directory (changeWorkingDirectory)
 import System.Posix.Files
 import System.Posix.Env
-import System.Posix.Process
 import Control.Exception.Extensible
 import qualified Data.Map as M
 import System.IO.HVFS (SystemFS(..))
@@ -48,6 +47,7 @@ import qualified Utility.Gpg
 import qualified Build.SysConfig
 import qualified Utility.Format
 import qualified Utility.Verifiable
+import qualified Utility.Process
 
 -- for quickcheck
 instance Arbitrary Types.Key.Key where
@@ -696,20 +696,10 @@ git_annex command params = do
 {- Runs git-annex and returns its output. -}
 git_annex_output :: String -> [String] -> IO String
 git_annex_output command params = do
-	(frompipe, topipe) <- createPipe
-	pid <- forkProcess $ do
-		_ <- dupTo topipe stdOutput
-		closeFd frompipe
-		_ <- git_annex command params
-		exitSuccess
+	got <- Utility.Process.readProcess "git-annex" (command:params)
 	-- XXX since the above is a separate process, code coverage stats are
 	-- not gathered for things run in it.
-	closeFd topipe
-	fromh <- fdToHandle frompipe
-	got <- hGetContentsStrict fromh
-	hClose fromh
-	_ <- getProcessStatus True False pid
-	-- XXX hack Run same command again, to get code coverage.
+	-- Run same command again, to get code coverage.
 	_ <- git_annex command params
 	return got
 
@@ -877,8 +867,9 @@ unannexed = runchecks [checkregularfile, checkcontent, checkwritable]
 
 prepare :: IO ()
 prepare = do
-	-- While PATH is mostly avoided, the commit hook does run it. Make
-	-- sure that the just-built git annex is used.
+	-- While PATH is mostly avoided, the commit hook does run it,
+	-- and so does git_annex_output. Make sure that the just-built
+	-- git annex is used.
 	cwd <- getCurrentDirectory
 	p <- getEnvDefault  "PATH" ""
 	setEnv "PATH" (cwd ++ ":" ++ p) True