mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Wait for server process in client_server_test (#12551)
withCreateProcess kills the server process but it doesn’t wait for it to finish. The `typed-process` version does things properly here which is also why we switched to it in other places. changelog_begin changelog_end
This commit is contained in:
parent
f1cd4b1c7c
commit
5bfe4ed589
@ -9,6 +9,7 @@ da_haskell_binary(
|
||||
hackage_deps = [
|
||||
"base",
|
||||
"extra",
|
||||
"typed-process",
|
||||
"process",
|
||||
"async",
|
||||
"text",
|
||||
|
@ -6,11 +6,13 @@ module Main(main) where
|
||||
import System.Environment
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad.Loops (untilJust)
|
||||
import System.Process
|
||||
import System.Process.Typed
|
||||
import Data.List.Split (splitOn)
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad (forM_, when)
|
||||
import Network.Socket
|
||||
import Control.Concurrent
|
||||
import System.Info.Extra
|
||||
import System.Process (terminateProcess)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@ -18,9 +20,11 @@ main = do
|
||||
let splitArgs = filter (/= "") . splitOn " "
|
||||
let serverProc = proc serverExe (splitArgs serverArgs)
|
||||
let ports :: [Int] = read <$> splitArgs runnerArgs
|
||||
withCreateProcess serverProc $ \_stdin _stdout _stderr _ph -> do
|
||||
withProcessTerm serverProc $ \ph -> do
|
||||
forM_ ports $ \port -> waitForConnectionOnPort (threadDelay 500000) port
|
||||
callProcess clientExe (splitArgs clientArgs)
|
||||
runProcess_ (proc clientExe (splitArgs clientArgs))
|
||||
-- See the comment on DA.Daml.Helper.Util.withProcessWait_'
|
||||
when isWindows (terminateProcess $ unsafeProcessHandle ph)
|
||||
|
||||
|
||||
waitForConnectionOnPort :: IO () -> Int -> IO ()
|
||||
|
@ -11,6 +11,7 @@ da_haskell_binary(
|
||||
"directory",
|
||||
"extra",
|
||||
"filepath",
|
||||
"typed-process",
|
||||
"process",
|
||||
],
|
||||
visibility = ["//visibility:public"],
|
||||
|
@ -3,15 +3,17 @@
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Control.Monad (unless, when)
|
||||
import Data.List.Extra (replace, splitOn, stripInfix)
|
||||
import Data.Maybe (isJust)
|
||||
import System.Environment (getArgs)
|
||||
import System.FilePath ((</>))
|
||||
import System.Process (callProcess, proc, withCreateProcess)
|
||||
import System.Process.Typed (proc, runProcess_, withProcessTerm, unsafeProcessHandle)
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import System.IO.Extra (withTempDir)
|
||||
import System.Info.Extra
|
||||
import System.Process (terminateProcess)
|
||||
|
||||
import DA.PortFile
|
||||
|
||||
@ -28,7 +30,9 @@ main = do
|
||||
let portFile = tempDir </> "portfile"
|
||||
let interpolatedServerArgs = map (replace "%PORT_FILE%" portFile) splitServerArgs
|
||||
let serverProc = proc serverExe interpolatedServerArgs
|
||||
withCreateProcess serverProc $ \_stdin _stdout _stderr ph -> do
|
||||
port <- readPortFile ph maxRetries portFile
|
||||
withProcessTerm serverProc $ \ph -> do
|
||||
port <- readPortFile (unsafeProcessHandle ph) maxRetries portFile
|
||||
let interpolatedClientArgs = map (replace "%PORT%" (show port)) splitClientArgs
|
||||
callProcess clientExe interpolatedClientArgs
|
||||
runProcess_ (proc clientExe interpolatedClientArgs)
|
||||
-- See the comment on DA.Daml.Helper.Util.withProcessWait_'
|
||||
when isWindows (terminateProcess $ unsafeProcessHandle ph)
|
||||
|
Loading…
Reference in New Issue
Block a user