distributed-process-client-server 0.2.2 → 0.2.3

raw patch · 6 files changed

+34/−6 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• distributed-process-client-server.cabal +1/−1
• src/Control/Distributed/Process/ManagedProcess/Client.hs +1/−3
• src/Control/Distributed/Process/ManagedProcess/Server.hs +1/−1
• tests/ManagedProcessCommon.hs +23/−0
• tests/TestManagedProcess.hs +4/−0
• tests/TestPrioritisedProcess.hs +4/−1

@@ -1,5 +1,5 @@ name:           distributed-process-client-server-version:        0.2.2+version:        0.2.3 cabal-version:  >=1.8 build-type:     Simple license:        BSD3

@@ -95,9 +95,7 @@   (fmap fromJust (initCall s m >>= waitResponse Nothing) :: Process (Either ExitReason b))     `catchesExit` [(\pid msg -> handleMessageIf msg (weFailed pid us)                                                     (return . Left))]-   where-     weFailed a b (ExitOther _) = a == b     weFailed _ _ _             = False @@ -147,7 +145,7 @@         decodeResult (Just (Right result)) = return $ Just result         decodeResult (Just (Left reason))  = die reason --- | Attempt to flush out any pending call responses. +-- | Attempt to flush out any pending call responses. flushPendingCalls :: forall b . (Serializable b)                   => TimeInterval                   -> (b -> Process b)

@@ -218,7 +218,7 @@ -- > replyTo = sendTo -- replyTo :: (Serializable m) => CallRef m -> m -> Process ()-replyTo = sendTo+replyTo cRef@(CallRef (_, tag)) msg = sendTo cRef $ CallResponse msg tag  -- | Sends a reply to a 'SendPort' (for use in 'handleRpcChan' et al). --

@@ -108,7 +108,30 @@   pid <- spawnLocal $ serve () (statelessInit Infinity) procDef   return $ StmServer pid inQ replyQ +deferredResponseServer :: Process ProcessId+deferredResponseServer =+  let procDef = defaultProcess {+      apiHandlers = [+          handleCallFrom (\r s (m :: String) -> noReply_ ((r, m):s) )+      ]+    , infoHandlers = [+          handleInfo (\s () -> (mapM_ (\t -> replyTo (fst t) (snd t)) s) >> continue [])+      ]+    } :: ProcessDefinition [(CallRef String, String)]+  in spawnLocal $ serve [] (\s -> return $ InitOk s Infinity) procDef+ -- common test cases++testDeferredCallResponse :: TestResult (AsyncResult String) -> Process ()+testDeferredCallResponse result = do+  pid <- deferredResponseServer+  r <- async $ task $ (call pid "Hello There" :: Process String)++  sleep $ seconds 2+  AsyncPending <- poll r++  send pid ()+  wait r >>= stash result  testBasicCall :: Launcher () -> TestResult (Maybe String) -> Process () testBasicCall launch result = do

@@ -12,6 +12,7 @@ import Control.Concurrent.MVar import Control.Exception (SomeException) import Control.Distributed.Process hiding (call, catch)+import Control.Distributed.Process.Async (AsyncResult(AsyncDone)) import Control.Distributed.Process.Node import Control.Distributed.Process.Extras hiding (__remoteTable, monitor, send, nsend) import Control.Distributed.Process.ManagedProcess@@ -235,6 +236,9 @@             (delayedAssertion              "expected n * 2 back from the server"              localNode (Just 4) (testUnsafeBasicCall_ $ wrap server))+           , testCase "basic deferred call handling"+             (delayedAssertion "expected a response sent via replyTo"+              localNode (AsyncDone "Hello There") testDeferredCallResponse)           , testCase "basic cast with manual send and explicit server continue"             (delayedAssertion              "expected pong back from the server"

@@ -529,7 +529,7 @@   -- the async worker has had a chance to deliver the longest string message,   -- our test will fail. Such races are /normal/ given that the async worker   -- runs in another process and delivery order between multiple processes-  -- is undefined (and in practise, paritally depenendent on the scheduler)+  -- is undefined (and in practise, partially depenendent on the scheduler)   sleep $ seconds 1   send pid ()   _ <- mapM wait asyncRefs :: Process [AsyncResult ()]@@ -550,6 +550,9 @@             (delayedAssertion              "expected n * 2 back from the server"              localNode (Just 4) (testBasicCall_ $ wrap server))+          , testCase "basic deferred call handling"+            (delayedAssertion "expected a response sent via replyTo"+             localNode (AsyncDone "Hello There") testDeferredCallResponse)           , testCase "basic cast with manual send and explicit server continue"             (delayedAssertion              "expected pong back from the server"