Skip to content

Commit

Permalink
Clear progress msg before running test commercialhaskell#1302
Browse files Browse the repository at this point in the history
+ add a trailing newline to test output
  • Loading branch information
mgsloan committed Dec 12, 2015
1 parent 84da80d commit 68ef027
Showing 1 changed file with 18 additions and 9 deletions.
27 changes: 18 additions & 9 deletions src/Stack/Build/Execute.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1205,18 +1205,24 @@ singleTest runInBase topts testsToRun ac ee task installedMap = do
[] -> ""
_ -> ", args: " <> T.intercalate " " (map showProcessArgDebug args)
announce $ "test (suite: " <> testName <> argsDisplay <> ")"
let cp = (proc (toFilePath exePath) args)

-- Clear "Progress: ..." message before
-- redirecting output.
when (isNothing mlogFile) $ do
$logStickyDone ""
liftIO $ hFlush stdout
liftIO $ hFlush stderr

let output =
case mlogFile of
Nothing -> Inherit
Just (_, h) -> UseHandle h
cp = (proc (toFilePath exePath) args)
{ cwd = Just $ toFilePath pkgDir
, Process.env = envHelper menv
, std_in = CreatePipe
, std_out =
case mlogFile of
Nothing -> Inherit
Just (_, h) -> UseHandle h
, std_err =
case mlogFile of
Nothing -> Inherit
Just (_, h) -> UseHandle h
, std_out = output
, std_err = output
}

-- Use createProcess_ to avoid the log file being closed afterwards
Expand All @@ -1227,6 +1233,9 @@ singleTest runInBase topts testsToRun ac ee task installedMap = do
liftIO $ hPutStr inH $ show (logPath, testName)
liftIO $ hClose inH
ec <- liftIO $ waitForProcess ph
-- Add a trailing newline, incase the test
-- output didn't finish with a newline.
when (isNothing mlogFile) ($logInfo "")
-- Move the .tix file out of the package
-- directory into the hpc work dir, for
-- tidiness.
Expand Down

0 comments on commit 68ef027

Please sign in to comment.