Detailed test support (fixes commercialhaskell#4453)

NorfairKing · Jan 14, 2019 · 4061e0f · 4061e0f
1 parent 03c1e55
commit 4061e0f
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 7 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -108,6 +108,8 @@ Bug fixes:
   [#4402](https://github.com/commercialhaskell/stack/pull/4402)
 * Fix handling of GitHub and URL templates on Windows. See
   [commercialhaskell/stack#4394](https://github.com/commercialhaskell/stack/issues/4394)
+* Ensure the detailed-0.9 type tests work.
+  See [#4453](https://github.com/commercialhaskell/stack/issues/4453).
 
 ## v1.9.3
 

diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
@@ -28,6 +28,7 @@ import           Crypto.Hash
 import           Data.Attoparsec.Text hiding (try)
 import qualified Data.ByteArray as Mem (convert)
 import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Base64.URL as B64URL
 import           Data.Char (isSpace)
 import           Conduit
@@ -1792,16 +1793,19 @@ singleTest topts testsToRun ac ee task installedMap = do
 
                         ec <- withWorkingDir (toFilePath pkgDir) $
                           proc (toFilePath exePath) args $ \pc0 -> do
-                            let pc = setStdin createPipe
+                            stdinBS <-
+                              if isTestTypeLib
+                                then do
+                                  logPath <- buildLogPath package (Just stestName)
+                                  ensureDir (parent logPath)
+                                  pure $ BL.fromStrict
+                                       $ encodeUtf8 $ fromString $ show (logPath, testName)
+                                else pure mempty
+                            let pc = setStdin (byteStringInput stdinBS)
                                    $ output setStdout
                                    $ output setStderr
                                      pc0
-                            withProcess pc $ \p -> do
-                              when isTestTypeLib $ do
-                                logPath <- buildLogPath package (Just stestName)
-                                ensureDir (parent logPath)
-                                liftIO $ hPutStr (getStdin p) $ show (logPath, testName)
-                              waitExitCode p
+                            runProcess pc
                         -- Add a trailing newline, incase the test
                         -- output didn't finish with a newline.
                         case outputType of