master..a48b822 · 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, isJust)

49+import Data.Maybe (isNothing)

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

51import Test.Framework (Test, testGroup)

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

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

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

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

738

739

739 pingServer <- forkProcess node1 ping

740 pingServer <- forkProcess node1 ping

740 deadProcess <- forkProcess node1 (return ())

741 deadProcess <- forkProcess node1 (return ())

749

750

750 pid <- verifyWhereIsRemote nid1 "ping"

751 pid <- verifyWhereIsRemote nid1 "ping"

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

752 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 [

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

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

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

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

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

765−

766 registerRemoteAsync nid1 "ping" deadProcess

765 registerRemoteAsync nid1 "ping" deadProcess

767 receiveWait [

766 receiveWait [

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

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

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

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

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

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

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

772−

773 unregisterRemoteAsync nid1 "dead"

770 unregisterRemoteAsync nid1 "dead"

774 receiveWait [

771 receiveWait [

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

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

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

1559

1560

1560 let nid = localNodeId node2

1561 let nid = localNodeId node2

1561 pid <- forkProcess node1 $ do

1562 pid <- forkProcess node1 $ do

1562− self <- getSelfPid

1563− runUntilRegistered nid self

1563+ getSelfPid >>= runUntilRegistered nid

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

1564+ liftIO $ takeMVar waitH

1565− expect :: Process ()

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

1567

1565

1568 runProcess node2 $ do

1566 runProcess node2 $ do

1569 register regName pid

1567 register regName pid

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

1571 res <- whereis regName

1568 res <- whereis regName

1572− send pid ()

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

1574 us <- getSelfPid

1569 us <- getSelfPid

1570+ liftIO $ do

1571+ putMVar waitH ()

1575− liftIO $ assertBool "expected (Just pid)" $ res == (Just pid)

1572+ assertBool "expected (Just pid)" $ res == (Just pid)

1576−

1577

1573

1578 -- This delay isn't essential!

1574 -- This delay isn't essential!

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

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

1598 regHere <- newEmptyMVar

1594 regHere <- newEmptyMVar

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

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

1600 res <- takeMVar regHere

1596 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)

1604

1598

1605 where

1599 where

1606 runUntilRegistered nid us = do

1600 runUntilRegistered nid us = do

1612

1606

1613 delayUntilMaybeUnregistered nid p = do

1607 delayUntilMaybeUnregistered nid p = do

1614 whereisRemoteAsync nid regName

1608 whereisRemoteAsync nid regName

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

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

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

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

1617 (const $ return ())

1611 (const $ return ())

1618 ]

1612 ]

1619− case res of

1620− Just () -> return ()

1613+ return ()

1621− Nothing -> delayUntilMaybeUnregistered nid p

1622

1614

1623 regName = "testRegisterRemote"

1615 regName = "testRegisterRemote"

1624

1616