@@ -46,11 +46,11 @@ import Control.Distributed.Process.Debug
4646import Control.Distributed.Process.Management.Internal.Types
4747import Control.Distributed.Process.Tests.Internal.Utils (shouldBe, pause)
4848import Control.Distributed.Process.Serializable (Serializable)
49−import Data.Maybe (isNothing)
49+import Data.Maybe (isNothing, isJust)
5050import Test.HUnit (Assertion, assertBool, assertFailure)
5151import Test.Framework (Test, testGroup)
5252import Test.Framework.Providers.HUnit (testCase)
53−import Control.Rematch hiding (match, isNothing)
53+import Control.Rematch hiding (match, isNothing, isJust)
5454import Control.Rematch.Run (Match(..))
5555
5656newtype Ping = Ping ProcessId
@@ -735,7 +735,6 @@ testRemoteRegistry :: TestTransport -> Assertion
735735testRemoteRegistry TestTransport{..} = do
736736 node1 <- newLocalNode testTransport initRemoteTable
737737 node2 <- newLocalNode testTransport initRemoteTable
738− done <- newEmptyMVar
739738
740739 pingServer <- forkProcess node1 ping
741740 deadProcess <- forkProcess node1 (return ())
@@ -750,6 +749,7 @@ testRemoteRegistry TestTransport{..} = do
750749
751750 pid <- verifyWhereIsRemote nid1 "ping"
752751 liftIO $ assertBool "Expected pindServer to match pid" $ pingServer == pid
752+
753753 us <- getSelfPid
754754 nsendRemote nid1 "ping" (Pong us)
755755 receiveWait [
@@ -759,22 +759,22 @@ testRemoteRegistry TestTransport{..} = do
759759 -- test that if process was not registered Nothing is returned
760760 -- in owner field.
761761 registerRemoteAsync nid1 "dead" deadProcess
762− receiveWait [
763− matchIf (\(RegisterReply label' False Nothing) -> "dead" == label')
764− (\(RegisterReply _ _ _) -> return ()) ]
762+ receiveWait [ matchIf (\(RegisterReply label' f mPid) -> "dead" == label')
763+ (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))
764+ ] >>= liftIO . assertBool "Expected False Nothing in RegisterReply"
765+
765766 registerRemoteAsync nid1 "ping" deadProcess
766767 receiveWait [
767− matchIf (\(RegisterReply label' False (Just pid'')) ->
768− "ping" == label' && pid'' == pingServer)
769− (\(RegisterReply _ _ _) -> return ()) ]
768+ matchIf (\(RegisterReply label' False mPid) ->
769+ "ping" == label' && isJust mPid)
770+ (\(RegisterReply _ f (Just pid'')) -> return (not f && pid'' == pingServer))
771+ ] >>= liftIO . assertBool "Expected False and (Just alreadyRegisteredPid) in RegisterReply"
772+
770773 unregisterRemoteAsync nid1 "dead"
771774 receiveWait [
772− matchIf (\(RegisterReply label' False Nothing) ->
773− "dead" == label' && pid == pingServer)
774− (\(RegisterReply _ _ _) -> return ()) ]
775− liftIO $ putMVar done ()
776−
777− takeMVar done
775+ matchIf (\(RegisterReply label' _ _) -> "dead" == label')
776+ (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))
777+ ] >>= liftIO . assertBool "Expected False and Nothing in RegisterReply"
778778
779779testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
780780testRemoteRegistryRemoteProcess TestTransport{..} = do
@@ -1556,20 +1556,24 @@ testRegistryMonitoring :: TestTransport -> Assertion
15561556testRegistryMonitoring TestTransport{..} = do
15571557 node1 <- newLocalNode testTransport initRemoteTable
15581558 node2 <- newLocalNode testTransport initRemoteTable
1559− waitH <- newEmptyMVar
15601559
15611560 let nid = localNodeId node2
15621561 pid <- forkProcess node1 $ do
1563− getSelfPid >>= runUntilRegistered nid
1564− liftIO $ takeMVar waitH
1562+ self <- getSelfPid
1563+ runUntilRegistered nid self
1564+ say $ (show self) ++ " registered as " ++ regName
1565+ expect :: Process ()
1566+ say $ (show self) ++ " exiting normally"
15651567
15661568 runProcess node2 $ do
15671569 register regName pid
1570+ say $ regName ++ " registered to " ++ show pid
15681571 res <- whereis regName
1572+ send pid ()
1573+ say $ " sent finish signal to " ++ show pid
15691574 us <- getSelfPid
1570− liftIO $ do
1571− putMVar waitH ()
1572− assertBool "expected (Just pid)" $ res == (Just pid)
1575+ liftIO $ assertBool "expected (Just pid)" $ res == (Just pid)
1576+
15731577
15741578 -- This delay isn't essential!
15751579 -- The test case passes perfectly fine without it (feel free to comment out
@@ -1594,7 +1598,9 @@ testRegistryMonitoring TestTransport{..} = do
15941598 regHere <- newEmptyMVar
15951599 runProcess node2 $ whereis regName >>= liftIO . putMVar regHere
15961600 res <- takeMVar regHere
1597− assertBool "expected Nothing, but process still registered" (res == Nothing)
1601+ case res of
1602+ Nothing -> return ()
1603+ Just pid -> assertBool ("expected Nothing, but got " ++ show pid) False
15981604
15991605 where
16001606 runUntilRegistered nid us = do
@@ -1606,11 +1612,13 @@ testRegistryMonitoring TestTransport{..} = do
16061612
16071613 delayUntilMaybeUnregistered nid p = do
16081614 whereisRemoteAsync nid regName
1609− receiveTimeout 20000000 {- 20 sec delay -} [
1610− matchIf (\(WhereIsReply n p) -> n == regName && p == Nothing)
1615+ res <- receiveTimeout 20000000 {- 20 sec delay -} [
1616+ matchIf (\(WhereIsReply n p) -> n == regName && isNothing p)
16111617 (const $ return ())
16121618 ]
1613− return ()
1619+ case res of
1620+ Just () -> return ()
1621+ Nothing -> delayUntilMaybeUnregistered nid p
16141622
16151623 regName = "testRegisterRemote"
16161624