@@ -295,6 +295,39 @@ testMath transport = do
295295
296296 takeMVar clientDone
297297
298+-- | Send first message (i.e. connect) to an already terminated process
299+-- (without monitoring); then send another message to a second process on
300+-- the same remote node (we're checking that the remote node did not die)
301+testSendToTerminated :: NT.Transport -> IO ()
302+testSendToTerminated transport = do
303+ serverAddr1 <- newEmptyMVar
304+ serverAddr2 <- newEmptyMVar
305+ clientDone <- newEmptyMVar
306+
307+ forkIO $ do
308+ terminated <- newEmptyMVar
309+ localNode <- newLocalNode transport initRemoteTable
310+ addr1 <- forkProcess localNode $ liftIO $ putMVar terminated ()
311+ addr2 <- forkProcess localNode $ ping
312+ readMVar terminated
313+ putMVar serverAddr1 addr1
314+ putMVar serverAddr2 addr2
315+
316+ forkIO $ do
317+ localNode <- newLocalNode transport initRemoteTable
318+ server1 <- readMVar serverAddr1
319+ server2 <- readMVar serverAddr2
320+ runProcess localNode $ do
321+ pid <- getSelfPid
322+ send server1 "Hi"
323+ send server2 (Pong pid)
324+ Ping pid' <- expect
325+ True <- return $ pid' == server2
326+ liftIO $ putMVar clientDone ()
327+
328+ takeMVar clientDone
329+
330+-- | Test (non-zero) timeout
298331testTimeout :: NT.Transport -> IO ()
299332testTimeout transport = do
300333 localNode <- newLocalNode transport initRemoteTable
@@ -302,15 +335,49 @@ testTimeout transport = do
302335 Nothing <- receiveTimeout 1000000 [match (\(Add _ _ _) -> return ())]
303336 return ()
304337
305−-- TODO: test timeout
338+-- | Test zero timeout
339+testTimeout0 :: NT.Transport -> IO ()
340+testTimeout0 transport = do
341+ serverAddr <- newEmptyMVar
342+ clientDone <- newEmptyMVar
343+ messagesSent <- newEmptyMVar
344+
345+ forkIO $ do
346+ localNode <- newLocalNode transport initRemoteTable
347+ addr <- forkProcess localNode $ do
348+ liftIO $ readMVar messagesSent >> threadDelay 1000000
349+ -- Variation on the venerable ping server which uses a zero timeout
350+ -- Since we wait for all messages to be sent before doing this receive,
351+ -- we should nevertheless find the right message immediately
352+ Just partner <- receiveTimeout 0 [match (\(Pong partner) -> return partner)]
353+ self <- getSelfPid
354+ send partner (Ping self)
355+ putMVar serverAddr addr
356+
357+ forkIO $ do
358+ localNode <- newLocalNode transport initRemoteTable
359+ server <- readMVar serverAddr
360+ runProcess localNode $ do
361+ pid <- getSelfPid
362+ -- Send a bunch of messages. A large number of messages that the server
363+ -- is not interested in, and then a single message that it wants
364+ replicateM_ 10000 $ send server "Irrelevant message"
365+ send server (Pong pid)
366+ liftIO $ putMVar messagesSent ()
367+ Ping _ <- expect
368+ liftIO $ putMVar clientDone ()
369+
370+ takeMVar clientDone
306371
307372main :: IO ()
308373main = do
309374 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters
310375 runTests
311− [ ("Ping", testPing transport)
312− , ("Math", testMath transport)
313− , ("Timeout", testTimeout transport)
376+ [ ("Ping", testPing transport)
377+ , ("Math", testMath transport)
378+ , ("Timeout", testTimeout transport)
379+ , ("Timeout0", testTimeout0 transport)
380+ , ("SendToTerminated", testSendToTerminated transport)
314381 -- The "missing" combinations in the list below don't make much sense, as
315382 -- we cannot guarantee that the monitor reply or link exception will not
316383 -- happen before the unmonitor or unlink