git.iko.soy/distributed-process
on master help sign in
d-p-tests: Fix SpawnRace.
dfff79fFacundo Domínguez
distributed-process-tests/src/Control/Distributed/Process/Tests/Closure.hs+5−3
@@ -305,14 +305,16 @@ testSpawnRace TestTransport{..} rtable = do
305 wrapEP e =
305 wrapEP e =
306 e { NT.connect = \x y z -> do
306 e { NT.connect = \x y z -> do
307 healthy <- newIORef True
307 healthy <- newIORef True
308− fmap (fmap $ wrapConnection healthy) $ NT.connect e x y z
308+ fmap (fmap $ wrapConnection healthy e x) $ NT.connect e x y z
309 }
309 }
310
310
311+ wrapConnection :: IORef Bool -> NT.EndPoint -> NT.EndPointAddress
311− wrapConnection :: IORef Bool -> NT.Connection -> NT.Connection
312+ -> NT.Connection -> NT.Connection
312− wrapConnection healthy (NT.Connection s closeC) =
313+ wrapConnection healthy e remoteAddr (NT.Connection s closeC) =
313 flip NT.Connection closeC $ \msg -> do
314 flip NT.Connection closeC $ \msg -> do
314 when (msg == messageToPayload (createMessage ())) $ do
315 when (msg == messageToPayload (createMessage ())) $ do
315 writeIORef healthy False
316 writeIORef healthy False
317+ testBreakConnection (NT.address e) remoteAddr
316 isHealthy <- readIORef healthy
318 isHealthy <- readIORef healthy
317 if isHealthy then s msg
319 if isHealthy then s msg
318 else return $ Left $ NT.TransportError NT.SendFailed ""
320 else return $ Left $ NT.TransportError NT.SendFailed ""