@@ -30,7 +30,7 @@ import Stackage.Prelude hiding (pi)
3030import System.Directory (findExecutable)
3131import System.Environment (getEnvironment)
3232import System.IO (IOMode (WriteMode),
33− withBinaryFile)
33+ openBinaryFile)
3434import System.IO.Temp (withSystemTempDirectory)
3535
3636data BuildException = BuildException (Map PackageName BuildFailure) [Text]
@@ -291,11 +291,12 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
291291 , display $ ppVersion $ piPlan sbPackageInfo
292292 ]
293293
294− runIn wdir outH cmd args =
295− withCheckedProcess cp $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
294+ runIn wdir getOutH cmd args = do
295+ outH <- getOutH
296+ withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
296297 (return () :: IO ())
297298 where
298− cp = (proc (unpack $ asText cmd) (map (unpack . asText) args))
299+ cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args))
299300 { cwd = Just $ fpToString wdir
300301 , std_out = UseHandle outH
301302 , std_err = UseHandle outH
@@ -321,8 +322,21 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
321322 testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"
322323
323324 wf fp inner' = do
324− createTree $ parent fp
325− withBinaryFile (fpToString fp) WriteMode inner'
325+ ref <- newIORef Nothing
326+ let cleanup = do
327+ mh <- readIORef ref
328+ forM_ mh hClose
329+ getH = do
330+ mh <- readIORef ref
331+ case mh of
332+ Just h -> return h
333+ Nothing -> mask_ $ do
334+ createTree $ parent fp
335+ h <- openBinaryFile (fpToString fp) WriteMode
336+ writeIORef ref $ Just h
337+ return h
338+
339+ inner' getH `finally` cleanup
326340
327341 configArgs = ($ []) $ execWriter $ do
328342 when pbAllowNewer $ tell' "--allow-newer"
@@ -350,15 +364,15 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
350364
351365 PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo
352366
353− buildLibrary = wf libOut $ \outH -> do
367+ buildLibrary = wf libOut $ \getOutH -> do
354368 let run a b = do when pbVerbose $ log' (unwords (a : b))
355− runChild outH a b
369+ runChild getOutH a b
356370
357371 isUnpacked <- newIORef False
358372 let withUnpacked inner = do
359373 unlessM (readIORef isUnpacked) $ do
360374 log' $ "Unpacking " ++ namever
361− runParent outH "cabal" ["unpack", namever]
375+ runParent getOutH "cabal" ["unpack", namever]
362376 writeIORef isUnpacked True
363377 inner
364378
@@ -440,8 +454,8 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
440454
441455 return withUnpacked
442456
443− runTests withUnpacked = wf testOut $ \outH -> do
444− let run = runChild outH
457+ runTests withUnpacked = wf testOut $ \getOutH -> do
458+ let run = runChild getOutH
445459
446460 prevTestResult <- getPreviousResult pb Test pident
447461 let needTest = pbEnableTests