dc65e6d · distributed-process

git.iko.soy/distributed-process

on master help sign in

add forward and uforward test cases

dc65e6dTim Watson8 years ago

distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+22−4

compare with master

unifiedsplit

@@ -5,7 +5,10 @@ import Control.Distributed.Process.Tests.Internal.Utils

5import Network.Transport.Test (TestTransport(..))

6import Control.Exception (SomeException)

7import Control.Distributed.Process hiding (bracket, finally, try)

8−import Control.Distributed.Process.Internal.Types (ProcessExitException(..))

8+import Control.Distributed.Process.Internal.Types

9+ ( ProcessExitException(..)

10+ , unsafeCreateUnencodedMessage

11+ )

9import Control.Distributed.Process.Node

12import Control.Distributed.Process.Node

10import qualified Control.Distributed.Process.UnsafePrimitives as Unsafe

13import qualified Control.Distributed.Process.UnsafePrimitives as Unsafe

11 ( send

14 ( send

@@ -321,8 +324,6 @@ testMxRegMon remoteNode result = do

321ensure :: Process () -> Process () -> Process ()

324ensure :: Process () -> Process () -> Process ()

322ensure = flip finally

325ensure = flip finally

323

326

324−type SendTest = ProcessId -> ReceivePort MxEvent -> Process Bool

325−

326testNSend :: (String -> () -> Process ())

327testNSend :: (String -> () -> Process ())

327 -> Maybe LocalNode

328 -> Maybe LocalNode

328 -> TestResult Bool

329 -> TestResult Bool

@@ -354,7 +355,10 @@ testNSend op n r = testMxSend n r $ \p1 sink -> do

354 | isJust n = l2 == l1 ++ "@" ++ show (localNodeId $ fromJust n)

355 | isJust n = l2 == l1 ++ "@" ++ show (localNodeId $ fromJust n)

355 | otherwise = False

356 | otherwise = False

356

357

357−testSend :: (ProcessId -> () -> Process ()) -> Maybe LocalNode -> TestResult Bool -> Process ()

358+testSend :: (ProcessId -> () -> Process ())

359+ -> Maybe LocalNode

360+ -> TestResult Bool

361+ -> Process ()

358testSend op n r = testMxSend n r $ \p1 sink -> do

362testSend op n r = testMxSend n r $ \p1 sink -> do

359 -- initiate a send

363 -- initiate a send

360 op p1 ()

364 op p1 ()

@@ -367,6 +371,8 @@ testSend op n r = testMxSend n r $ \p1 sink -> do

367 | pidTo == p1 && pidFrom == us -> return True

371 | pidTo == p1 && pidFrom == us -> return True

368 _ -> return False

372 _ -> return False

369

373

374+type SendTest = ProcessId -> ReceivePort MxEvent -> Process Bool

375+

370testMxSend :: Maybe LocalNode -> TestResult Bool -> SendTest -> Process ()

376testMxSend :: Maybe LocalNode -> TestResult Bool -> SendTest -> Process ()

371testMxSend mNode result test = do

377testMxSend mNode result test = do

372 us <- getSelfPid

378 us <- getSelfPid

@@ -467,6 +473,12 @@ tests TestTransport{..} = do

467 , testCase "usend"

473 , testCase "usend"

468 (delayedAssertion "expected mx events failed"

474 (delayedAssertion "expected mx events failed"

469 node1 True (testSend usend $ Just node2))

475 node1 True (testSend usend $ Just node2))

476+ , testCase "forward"

477+ (delayedAssertion "expected mx events failed"

478+ node1 True (testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p) $ Just node2))

479+ , testCase "uforward"

480+ (delayedAssertion "expected mx events failed"

481+ node1 True (testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p) $ Just node2))

470 ]

482 ]

471 , testGroup "LocalTargets" [

483 , testGroup "LocalTargets" [

472 testCase "Unsafe.nsend"

484 testCase "Unsafe.nsend"

@@ -487,6 +499,12 @@ tests TestTransport{..} = do

487 , testCase "usend"

499 , testCase "usend"

488 (delayedAssertion "expected mx events failed"

500 (delayedAssertion "expected mx events failed"

489 node1 True (testSend usend Nothing))

501 node1 True (testSend usend Nothing))

502+ , testCase "forward"

503+ (delayedAssertion "expected mx events failed"

504+ node1 True (testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p) Nothing))

505+ , testCase "uforward"

506+ (delayedAssertion "expected mx events failed"

507+ node1 True (testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p) Nothing))

490 ]

508 ]

491 ]

509 ]

492 ]

510 ]