24240ac..master · distributed-process

46import Control.Distributed.Process.Management.Internal.Types

47import Control.Distributed.Process.Tests.Internal.Utils (shouldBe, pause)

48import Control.Distributed.Process.Serializable (Serializable)

49−import Data.Maybe (isNothing)

49+import Data.Maybe (isNothing, isJust)

50import Test.HUnit (Assertion, assertBool, assertFailure)

51import Test.Framework (Test, testGroup)

52import Test.Framework.Providers.HUnit (testCase)

53−import Control.Rematch hiding (match, isNothing)

53+import Control.Rematch hiding (match, isNothing, isJust)

54import Control.Rematch.Run (Match(..))

55

56newtype Ping = Ping ProcessId

735testRemoteRegistry TestTransport{..} = do

736 node1 <- newLocalNode testTransport initRemoteTable

737 node2 <- newLocalNode testTransport initRemoteTable

738− done <- newEmptyMVar

739

738

740 pingServer <- forkProcess node1 ping

739 pingServer <- forkProcess node1 ping

741 deadProcess <- forkProcess node1 (return ())

740 deadProcess <- forkProcess node1 (return ())

750

749

751 pid <- verifyWhereIsRemote nid1 "ping"

750 pid <- verifyWhereIsRemote nid1 "ping"

752 liftIO $ assertBool "Expected pindServer to match pid" $ pingServer == pid

751 liftIO $ assertBool "Expected pindServer to match pid" $ pingServer == pid

752+

753 us <- getSelfPid

754 nsendRemote nid1 "ping" (Pong us)

755 receiveWait [

759 -- test that if process was not registered Nothing is returned

760 -- in owner field.

761 registerRemoteAsync nid1 "dead" deadProcess

762− receiveWait [

763− matchIf (\(RegisterReply label' False Nothing) -> "dead" == label')

762+ receiveWait [ matchIf (\(RegisterReply label' f mPid) -> "dead" == label')

764− (\(RegisterReply _ _ _) -> return ()) ]

763+ (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))

764+ ] >>= liftIO . assertBool "Expected False Nothing in RegisterReply"

765+

765 registerRemoteAsync nid1 "ping" deadProcess

766 registerRemoteAsync nid1 "ping" deadProcess

766 receiveWait [

767 receiveWait [

767− matchIf (\(RegisterReply label' False (Just pid'')) ->

768+ matchIf (\(RegisterReply label' False mPid) ->

768− "ping" == label' && pid'' == pingServer)

769+ "ping" == label' && isJust mPid)

769− (\(RegisterReply _ _ _) -> return ()) ]

770+ (\(RegisterReply _ f (Just pid'')) -> return (not f && pid'' == pingServer))

771+ ] >>= liftIO . assertBool "Expected False and (Just alreadyRegisteredPid) in RegisterReply"

772+

770 unregisterRemoteAsync nid1 "dead"

773 unregisterRemoteAsync nid1 "dead"

771 receiveWait [

774 receiveWait [

772− matchIf (\(RegisterReply label' False Nothing) ->

775+ matchIf (\(RegisterReply label' _ _) -> "dead" == label')

773− "dead" == label' && pid == pingServer)

776+ (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))

774− (\(RegisterReply _ _ _) -> return ()) ]

777+ ] >>= liftIO . assertBool "Expected False and Nothing in RegisterReply"

775− liftIO $ putMVar done ()

776−

777− takeMVar done

778

779testRemoteRegistryRemoteProcess :: TestTransport -> Assertion

780testRemoteRegistryRemoteProcess TestTransport{..} = do

1556testRegistryMonitoring TestTransport{..} = do

1557 node1 <- newLocalNode testTransport initRemoteTable

1558 node2 <- newLocalNode testTransport initRemoteTable

1559− waitH <- newEmptyMVar

1560

1559

1561 let nid = localNodeId node2

1560 let nid = localNodeId node2

1562 pid <- forkProcess node1 $ do

1561 pid <- forkProcess node1 $ do

1562+ self <- getSelfPid

1563− getSelfPid >>= runUntilRegistered nid

1563+ runUntilRegistered nid self

1564− liftIO $ takeMVar waitH

1564+ say $ (show self) ++ " registered as " ++ regName

1565+ expect :: Process ()

1566+ say $ (show self) ++ " exiting normally"

1565

1567

1566 runProcess node2 $ do

1568 runProcess node2 $ do

1567 register regName pid

1569 register regName pid

1570+ say $ regName ++ " registered to " ++ show pid

1568 res <- whereis regName

1571 res <- whereis regName

1572+ send pid ()

1573+ say $ " sent finish signal to " ++ show pid

1569 us <- getSelfPid

1574 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+

1573

1577

1574 -- This delay isn't essential!

1578 -- This delay isn't essential!

1575 -- The test case passes perfectly fine without it (feel free to comment out

1579 -- The test case passes perfectly fine without it (feel free to comment out

1594 regHere <- newEmptyMVar

1598 regHere <- newEmptyMVar

1595 runProcess node2 $ whereis regName >>= liftIO . putMVar regHere

1599 runProcess node2 $ whereis regName >>= liftIO . putMVar regHere

1596 res <- takeMVar regHere

1600 res <- takeMVar regHere

1601+ case res of

1602+ Nothing -> return ()

1597− assertBool "expected Nothing, but process still registered" (res == Nothing)

1603+ Just pid -> assertBool ("expected Nothing, but got " ++ show pid) False

1598

1604

1599 where

1605 where

1600 runUntilRegistered nid us = do

1606 runUntilRegistered nid us = do

1606

1612

1607 delayUntilMaybeUnregistered nid p = do

1613 delayUntilMaybeUnregistered nid p = do

1608 whereisRemoteAsync nid regName

1614 whereisRemoteAsync nid regName

1609− receiveTimeout 20000000 {- 20 sec delay -} [

1615+ res <- receiveTimeout 20000000 {- 20 sec delay -} [

1610− matchIf (\(WhereIsReply n p) -> n == regName && p == Nothing)

1616+ matchIf (\(WhereIsReply n p) -> n == regName && isNothing p)

1611 (const $ return ())

1617 (const $ return ())

1612 ]

1618 ]

1619+ case res of

1613− return ()

1620+ Just () -> return ()

1621+ Nothing -> delayUntilMaybeUnregistered nid p

1614

1622

1615 regName = "testRegisterRemote"

1623 regName = "testRegisterRemote"

1616

1624