@@ -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, isJust)
49+import Data.Maybe (isNothing)
5050import Test.HUnit (Assertion, assertBool, assertFailure)
5151import Test.Framework (Test, testGroup)
5252import Test.Framework.Providers.HUnit (testCase)
53−import Control.Rematch hiding (match, isNothing, isJust)
53+import Control.Rematch hiding (match, isNothing)
5454import Control.Rematch.Run (Match(..))
5555
5656newtype Ping = Ping ProcessId
@@ -735,6 +735,7 @@ testRemoteRegistry :: TestTransport -> Assertion
735735testRemoteRegistry TestTransport{..} = do
736736 node1 <- newLocalNode testTransport initRemoteTable
737737 node2 <- newLocalNode testTransport initRemoteTable
738+ done <- newEmptyMVar
738739
739740 pingServer <- forkProcess node1 ping
740741 deadProcess <- forkProcess node1 (return ())
@@ -749,7 +750,6 @@ testRemoteRegistry TestTransport{..} = do
749750
750751 pid <- verifyWhereIsRemote nid1 "ping"
751752 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 [ 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−
762+ receiveWait [
763+ matchIf (\(RegisterReply label' False Nothing) -> "dead" == label')
764+ (\(RegisterReply _ _ _) -> return ()) ]
766765 registerRemoteAsync nid1 "ping" deadProcess
767766 receiveWait [
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−
767+ matchIf (\(RegisterReply label' False (Just pid'')) ->
768+ "ping" == label' && pid'' == pingServer)
769+ (\(RegisterReply _ _ _) -> return ()) ]
773770 unregisterRemoteAsync nid1 "dead"
774771 receiveWait [
775− matchIf (\(RegisterReply label' _ _) -> "dead" == label')
776− (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))
777− ] >>= liftIO . assertBool "Expected False and Nothing in RegisterReply"
772+ matchIf (\(RegisterReply label' False Nothing) ->
773+ "dead" == label' && pid == pingServer)
774+ (\(RegisterReply _ _ _) -> return ()) ]
775+ liftIO $ putMVar done ()
776+
777+ takeMVar done
778778
779779testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
780780testRemoteRegistryRemoteProcess TestTransport{..} = do
@@ -1556,24 +1556,20 @@ testRegistryMonitoring :: TestTransport -> Assertion
15561556testRegistryMonitoring TestTransport{..} = do
15571557 node1 <- newLocalNode testTransport initRemoteTable
15581558 node2 <- newLocalNode testTransport initRemoteTable
1559+ waitH <- newEmptyMVar
15591560
15601561 let nid = localNodeId node2
15611562 pid <- forkProcess node1 $ do
1562− self <- getSelfPid
1563− runUntilRegistered nid self
1564− say $ (show self) ++ " registered as " ++ regName
1565− expect :: Process ()
1566− say $ (show self) ++ " exiting normally"
1563+ getSelfPid >>= runUntilRegistered nid
1564+ liftIO $ takeMVar waitH
15671565
15681566 runProcess node2 $ do
15691567 register regName pid
1570− say $ regName ++ " registered to " ++ show pid
15711568 res <- whereis regName
1572− send pid ()
1573− say $ " sent finish signal to " ++ show pid
15741569 us <- getSelfPid
1575− liftIO $ assertBool "expected (Just pid)" $ res == (Just pid)
1576−
1570+ liftIO $ do
1571+ putMVar waitH ()
1572+ assertBool "expected (Just pid)" $ res == (Just pid)
15771573
15781574 -- This delay isn't essential!
15791575 -- The test case passes perfectly fine without it (feel free to comment out
@@ -1598,9 +1594,7 @@ testRegistryMonitoring TestTransport{..} = do
15981594 regHere <- newEmptyMVar
15991595 runProcess node2 $ whereis regName >>= liftIO . putMVar regHere
16001596 res <- takeMVar regHere
1601− case res of
1602− Nothing -> return ()
1603− Just pid -> assertBool ("expected Nothing, but got " ++ show pid) False
1597+ assertBool "expected Nothing, but process still registered" (res == Nothing)
16041598
16051599 where
16061600 runUntilRegistered nid us = do
@@ -1612,13 +1606,11 @@ testRegistryMonitoring TestTransport{..} = do
16121606
16131607 delayUntilMaybeUnregistered nid p = do
16141608 whereisRemoteAsync nid regName
1615− res <- receiveTimeout 20000000 {- 20 sec delay -} [
1616− matchIf (\(WhereIsReply n p) -> n == regName && isNothing p)
1609+ receiveTimeout 20000000 {- 20 sec delay -} [
1610+ matchIf (\(WhereIsReply n p) -> n == regName && p == Nothing)
16171611 (const $ return ())
16181612 ]
1619− case res of
1620− Just () -> return ()
1621− Nothing -> delayUntilMaybeUnregistered nid p
1613+ return ()
16221614
16231615 regName = "testRegisterRemote"
16241616