@@ -9,6 +9,7 @@ import Network.Transport.Test (TestTransport(..))
99import Data.Binary (Binary(..))
1010import Data.Typeable (Typeable)
1111import Data.Foldable (forM_)
12+import Data.Function (fix)
1213import Data.IORef
1314 ( readIORef
1415 , writeIORef
@@ -410,16 +411,14 @@ testTimeout0 :: TestTransport -> Assertion
410411testTimeout0 TestTransport{..} = do
411412 serverAddr <- newEmptyMVar
412413 clientDone <- newEmptyMVar
413− messagesSent <- newEmptyMVar
414414
415415 forkIO $ do
416416 localNode <- newLocalNode testTransport initRemoteTable
417417 addr <- forkProcess localNode $ do
418− liftIO $ readMVar messagesSent >> threadDelay 1000000
419418 -- Variation on the venerable ping server which uses a zero timeout
420− -- Since we wait for all messages to be sent before doing this receive,
421− -- we should nevertheless find the right message immediately
422− Just partner <- receiveTimeout 0 [match (\(Pong partner) -> return partner)]
419+ partner <- fix $ \loop ->
420+ receiveTimeout 0 [match (\(Pong partner) -> return partner)]
421+ >>= maybe (liftIO (threadDelay 100000) >> loop) return
423422 self <- getSelfPid
424423 send partner (Ping self)
425424 putMVar serverAddr addr
@@ -433,7 +432,6 @@ testTimeout0 TestTransport{..} = do
433432 -- is not interested in, and then a single message that it wants
434433 replicateM_ 10000 $ send server "Irrelevant message"
435434 send server (Pong pid)
436− liftIO $ putMVar messagesSent ()
437435 Ping _ <- expect
438436 liftIO $ putMVar clientDone ()
439437