distributed-process-async 0.2.3 → 0.2.4
raw patch · 4 files changed
+124/−198 lines, 4 filesdep +distributed-process-systestdep +exceptionsdep −derivedep −distributed-process-testsdep −ghc-primdep ~distributed-processdep ~distributed-process-extrasPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: distributed-process-systest, exceptions
Dependencies removed: derive, distributed-process-tests, ghc-prim, template-haskell, uniplate
Dependency ranges changed: distributed-process, distributed-process-extras
API changes (from Hackage documentation)
- Control.Distributed.Process.Async: waitTimeoutSTM :: (Serializable a) => TimeInterval -> Async a -> Process (Maybe (AsyncResult a))
+ Control.Distributed.Process.Async: asyncWorker :: Async a -> ProcessId
- Control.Distributed.Process.Async: waitAnyTimeout :: (Serializable a) => TimeInterval -> [Async a] -> Process (Maybe (AsyncResult a))
+ Control.Distributed.Process.Async: waitAnyTimeout :: (Serializable a) => Int -> [Async a] -> Process (Maybe (AsyncResult a))
- Control.Distributed.Process.Async: waitCancelTimeout :: (Serializable a) => TimeInterval -> Async a -> Process (AsyncResult a)
+ Control.Distributed.Process.Async: waitCancelTimeout :: (Serializable a) => Int -> Async a -> Process (AsyncResult a)
- Control.Distributed.Process.Async: waitCheckTimeout :: (Serializable a) => TimeInterval -> Async a -> Process (AsyncResult a)
+ Control.Distributed.Process.Async: waitCheckTimeout :: (Serializable a) => Int -> Async a -> Process (AsyncResult a)
- Control.Distributed.Process.Async: waitTimeout :: (Serializable a) => TimeInterval -> Async a -> Process (Maybe (AsyncResult a))
+ Control.Distributed.Process.Async: waitTimeout :: (Serializable a) => Int -> Async a -> Process (Maybe (AsyncResult a))
Files
- distributed-process-async.cabal +14/−17
- src/Control/Distributed/Process/Async.hs +44/−90
- src/Control/Distributed/Process/Async/Internal/Types.hs +12/−6
- tests/TestAsync.hs +54/−85
distributed-process-async.cabal view
@@ -1,13 +1,13 @@ name: distributed-process-async-version: 0.2.3+version: 0.2.4 cabal-version: >=1.8 build-type: Simple license: BSD3 license-file: LICENCE stability: experimental-Copyright: Tim Watson 2012 - 2014+Copyright: Tim Watson 2012 - 2016 Author: Tim Watson-Maintainer: watson.timothy@gmail.com+Maintainer: Tim Watson <watson.timothy@gmail.com> Stability: experimental Homepage: http://github.com/haskell-distributed/distributed-process-async Bug-Reports: http://github.com/haskell-distributed/distributed-process-async/issues@@ -16,7 +16,7 @@ concurrent, possibly distributed Process that will eventually deliver a value of type a. The package provides ways to create Async computations, wait for their results, and cancel them. category: Control-tested-with: GHC == 7.4.2 GHC == 7.6.2+tested-with: GHC == 7.8.4 GHC == 7.10.3 data-dir: "" source-repository head@@ -31,9 +31,10 @@ build-depends: base >= 4.4 && < 5, data-accessor >= 0.2.2.3,- distributed-process >= 0.5.3 && < 0.7,- distributed-process-extras >= 0.2.0 && < 0.3,- binary >= 0.6.3.0 && < 0.8,+ distributed-process >= 0.6.1 && < 0.7,+ distributed-process-extras >= 0.3.0 && < 0.4,+ exceptions >= 0.8.2.1 && < 0.9,+ binary >= 0.6.3.0 && < 0.9, deepseq >= 1.3.0.1 && < 1.5, mtl, containers >= 0.4 && < 0.6,@@ -41,13 +42,8 @@ unordered-containers >= 0.2.3.0 && < 0.3, fingertree < 0.2, stm >= 2.4 && < 2.5,- time > 1.4 && < 1.6,+ time > 1.4 && < 1.7, transformers- if impl(ghc <= 7.5)- Build-Depends: template-haskell == 2.7.0.0,- derive == 2.5.5,- uniplate == 1.6.12,- ghc-prim extensions: CPP InstanceSigs hs-source-dirs: src@@ -63,14 +59,15 @@ build-depends: base >= 4.4 && < 5, ansi-terminal >= 0.5 && < 0.7,- distributed-process >= 0.5.3 && < 0.7,- distributed-process-extras >= 0.2.0 && < 0.3,+ distributed-process >= 0.6.1 && < 0.7,+ distributed-process-extras >= 0.3.0 && < 0.4, distributed-process-async,- distributed-process-tests >= 0.4.1 && < 0.5,+ distributed-process-systest >= 0.1.0 && < 0.2.0,+ exceptions >= 0.8.2.1 && < 0.9, network >= 2.5 && < 2.7, network-transport >= 0.4 && < 0.5, network-transport-tcp >= 0.4 && < 0.6,- binary >= 0.6.3.0 && < 0.8,+ binary >= 0.6.3.0 && < 0.9, deepseq >= 1.3.0.1 && < 1.5, HUnit >= 1.2 && < 2, stm >= 2.3 && < 2.5,
src/Control/Distributed/Process/Async.hs view
@@ -35,6 +35,7 @@ , task , remoteTask , monitorAsync+ , asyncWorker -- * Cancelling asynchronous operations , cancel , cancelWait@@ -52,37 +53,25 @@ , waitCheckTimeout -- * STM versions , pollSTM- , waitTimeoutSTM , waitAnyCancel , waitEither , waitEither_ , waitBoth ) where -#if ! MIN_VERSION_base(4,6,0)-import Prelude hiding (catch)-#endif- import Control.Applicative import Control.Concurrent.STM hiding (check)-import Control.Distributed.Process+import Control.Distributed.Process hiding (catch, finally) import Control.Distributed.Process.Serializable import Control.Distributed.Process.Async.Internal.Types-import Control.Distributed.Process.Extras- ( CancelWait(..)- , Channel- , Resolvable(..)- )-import Control.Distributed.Process.Extras.Time- ( asTimeout- , TimeInterval- ) import Control.Monad+import Control.Monad.Catch (finally) import Data.Maybe ( fromMaybe ) import System.Timeout (timeout)+import Prelude -- | Wraps a regular @Process a@ as an 'AsyncTask'. task :: Process a -> AsyncTask a@@ -97,11 +86,7 @@ -- | Given an 'Async' handle, monitor the worker process. monitorAsync :: Async a -> Process MonitorRef-monitorAsync hAsync = do- worker <- resolve hAsync- case worker of- Nothing -> die "Invalid Async Handle"- Just p -> monitor p+monitorAsync = monitor . _asyncWorker -- | Spawns an asynchronous action and returns a handle to it, -- which can be used to obtain its status and/or result or interact@@ -110,6 +95,10 @@ async :: (Serializable a) => AsyncTask a -> Process (Async a) async = asyncDo False +-- | Provides the pid of the worker process performing the async operation.+asyncWorker :: Async a -> ProcessId+asyncWorker = _asyncWorker+ -- | This is a useful variant of 'async' that ensures an @Async@ task is -- never left running unintentionally. We ensure that if the caller's process -- exits, that the worker is killed.@@ -126,11 +115,11 @@ -- private API asyncDo :: (Serializable a) => Bool -> AsyncTask a -> Process (Async a) asyncDo shouldLink (AsyncRemoteTask d n c) =- let proc = call d n c in asyncDo shouldLink AsyncTask { asyncTask = proc }+ asyncDo shouldLink $ AsyncTask $ call d n c asyncDo shouldLink (AsyncTask proc) = do root <- getSelfPid- result <- liftIO $ newEmptyTMVarIO- sigStart <- liftIO $ newEmptyTMVarIO+ result <- liftIO newEmptyTMVarIO+ sigStart <- liftIO newEmptyTMVarIO (sp, rp) <- newChan -- listener/response proxy@@ -143,9 +132,7 @@ sendChan sp worker -- let the parent process know the worker pid wref <- monitor worker- rref <- case shouldLink of- True -> monitor root >>= return . Just- False -> return Nothing+ rref <- if shouldLink then fmap Just (monitor root) else return Nothing finally (pollUntilExit worker result) (unmonitor wref >> return (maybe (return ()) unmonitor rref))@@ -153,11 +140,10 @@ workerPid <- receiveChan rp liftIO $ atomically $ putTMVar sigStart () - return Async {- _asyncWorker = workerPid- , _asyncMonitor = insulator- , _asyncWait = (readTMVar result)- }+ return Async { _asyncWorker = workerPid+ , _asyncMonitor = insulator+ , _asyncWait = readTMVar result+ } where pollUntilExit :: (Serializable a)@@ -166,7 +152,7 @@ -> Process () pollUntilExit wpid result' = do r <- receiveWait [- match (\c@(CancelWait) -> kill wpid "cancel" >> return (Left c))+ match (\c@CancelWait -> kill wpid "cancel" >> return (Left c)) , match (\(ProcessMonitorNotification _ pid' r) -> return (Right (pid', r))) ]@@ -174,35 +160,37 @@ Left CancelWait -> liftIO $ atomically $ putTMVar result' AsyncCancelled Right (fpid, d)- | fpid == wpid- -> case d of- DiedNormal -> return ()- _ -> liftIO $ atomically $ putTMVar result' (AsyncFailed d)- | otherwise -> kill wpid "linkFailed"+ | fpid == wpid -> case d of+ DiedNormal -> return ()+ _ -> liftIO $ atomically $ void $+ tryPutTMVar result' (AsyncFailed d)+ | otherwise -> do+ kill wpid "linkFailed"+ receiveWait+ [ matchIf (\(ProcessMonitorNotification _ pid' _) ->+ pid' == wpid+ ) $ \_ -> return ()+ ]+ liftIO $ atomically $ void $+ tryPutTMVar result' (AsyncLinkFailed d) -- | Check whether an 'Async' has completed yet.------ See "Control.Distributed.Process.Platform.Async". poll :: (Serializable a) => Async a -> Process (AsyncResult a) poll hAsync = do r <- liftIO $ atomically $ pollSTM hAsync- return $ fromMaybe (AsyncPending) r+ return $ fromMaybe AsyncPending r -- | Like 'poll' but returns 'Nothing' if @(poll hAsync) == AsyncPending@.------ See "Control.Distributed.Process.Platform.Async". check :: (Serializable a) => Async a -> Process (Maybe (AsyncResult a)) check hAsync = poll hAsync >>= \r -> case r of AsyncPending -> return Nothing ar -> return (Just ar) -- | Wait for an asynchronous operation to complete or timeout.------ See "Control.Distributed.Process.Platform.Async". waitCheckTimeout :: (Serializable a) =>- TimeInterval -> Async a -> Process (AsyncResult a)+ Int -> Async a -> Process (AsyncResult a) waitCheckTimeout t hAsync =- waitTimeout t hAsync >>= return . fromMaybe (AsyncPending)+ fmap (fromMaybe AsyncPending) (waitTimeout t hAsync) -- | Wait for an asynchronous action to complete, and return its -- value. The result (which can include failure and/or cancellation) is@@ -210,27 +198,21 @@ -- -- @wait = liftIO . atomically . waitSTM@ ----- See "Control.Distributed.Process.Platform.Async". {-# INLINE wait #-} wait :: Async a -> Process (AsyncResult a) wait = liftIO . atomically . waitSTM -- | Wait for an asynchronous operation to complete or timeout.------ See "Control.Distributed.Process.Platform.Async". waitTimeout :: (Serializable a) =>- TimeInterval -> Async a -> Process (Maybe (AsyncResult a))-waitTimeout t hAsync = do- -- This is not the most efficient thing to do, but it's the most erlang-ish.- (sp, rp) <- newChan :: (Serializable a) => Process (Channel (AsyncResult a))- pid <- spawnLocal $ wait hAsync >>= sendChan sp- receiveChanTimeout (asTimeout t) rp `finally` kill pid "timeout"+ Int -> Async a -> Process (Maybe (AsyncResult a))+waitTimeout t hAsync =+ liftIO $ timeout t $ atomically $ waitSTM hAsync -- | Wait for an asynchronous operation to complete or timeout. -- If it times out, then 'cancelWait' the async handle. -- waitCancelTimeout :: (Serializable a)- => TimeInterval+ => Int -> Async a -> Process (AsyncResult a) waitCancelTimeout t hAsync = do@@ -239,15 +221,6 @@ Nothing -> cancelWait hAsync Just ar -> return ar --- | As 'waitTimeout' but uses STM directly, which might be more efficient.-waitTimeoutSTM :: (Serializable a)- => TimeInterval- -> Async a- -> Process (Maybe (AsyncResult a))-waitTimeoutSTM t hAsync =- let t' = (asTimeout t)- in liftIO $ timeout t' $ atomically $ waitSTM hAsync- -- | Wait for any of the supplied @Async@s to complete. If multiple -- 'Async's complete, then the value returned corresponds to the first -- completed 'Async' in the list.@@ -260,9 +233,7 @@ waitAny :: (Serializable a) => [Async a] -> Process (Async a, AsyncResult a)-waitAny asyncs = do- r <- liftIO $ waitAnySTM asyncs- return r+waitAny asyncs = liftIO $ waitAnySTM asyncs -- | Like 'waitAny', but also cancels the other asynchronous -- operations as soon as one has completed.@@ -296,7 +267,7 @@ -- waitBoth :: Async a -> Async b- -> Process ((AsyncResult a), (AsyncResult b))+ -> Process (AsyncResult a, AsyncResult b) waitBoth left right = liftIO $ atomically $ do a <- waitSTM left@@ -307,46 +278,29 @@ -- | Like 'waitAny' but times out after the specified delay. waitAnyTimeout :: (Serializable a)- => TimeInterval+ => Int -> [Async a] -> Process (Maybe (AsyncResult a)) waitAnyTimeout delay asyncs =- let t' = asTimeout delay- in liftIO $ timeout t' $ do+ liftIO $ timeout delay $ do r <- waitAnySTM asyncs return $ snd r -- | Cancel an asynchronous operation.------ See "Control.Distributed.Process.Platform.Async". cancel :: Async a -> Process () cancel (Async _ g _) = send g CancelWait -- | Cancel an asynchronous operation and wait for the cancellation to complete.------ See "Control.Distributed.Process.Platform.Async". cancelWait :: (Serializable a) => Async a -> Process (AsyncResult a) cancelWait hAsync = cancel hAsync >> wait hAsync -- | Cancel an asynchronous operation immediately.------ See "Control.Distributed.Process.Platform.Async". cancelWith :: (Serializable b) => b -> Async a -> Process ()-cancelWith reason hAsync = do- worker <- resolve hAsync- case worker of- Nothing -> die "Invalid Async Handle"- Just ref -> exit ref reason+cancelWith reason hAsync = exit (_asyncWorker hAsync) reason -- | Like 'cancelWith' but sends a @kill@ instruction instead of an exit.------ See 'Control.Distributed.Process.Platform.Async'. cancelKill :: String -> Async a -> Process ()-cancelKill reason hAsync = do- worker <- resolve hAsync- case worker of- Nothing -> die "Invalid Async Handle"- Just ref -> kill ref reason+cancelKill reason hAsync = kill (_asyncWorker hAsync) reason -------------------------------------------------------------------------------- -- STM Specific API --
src/Control/Distributed/Process/Async/Internal/Types.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-} -- | shared, internal types for the Async package module Control.Distributed.Process.Async.Internal.Types@@ -12,17 +13,18 @@ , AsyncRef , AsyncTask(..) , AsyncResult(..)+ , CancelWait(..) ) where import Control.Concurrent.STM import Control.Distributed.Process-import Control.Distributed.Process.Extras (Resolvable(..)) import Control.Distributed.Process.Serializable ( Serializable , SerializableDict ) import Data.Binary import Data.Typeable (Typeable)+import Data.Monoid import GHC.Generics @@ -40,14 +42,13 @@ _asyncWorker :: AsyncRef , _asyncMonitor :: AsyncRef , _asyncWait :: STM (AsyncResult a)- }+ } deriving (Functor) instance Eq (Async a) where Async a b _ == Async c d _ = a == c && b == d -instance Resolvable (Async a) where- resolve :: Async a -> Process (Maybe ProcessId)- resolve = return . Just . _asyncWorker+instance Ord (Async a) where+ compare (Async a b _) (Async c d _) = a `compare` c <> b `compare` d -- | A task to be performed asynchronously. data AsyncTask a =@@ -71,10 +72,15 @@ | AsyncLinkFailed DiedReason -- ^ a link failure and the reason | AsyncCancelled -- ^ a cancelled action | AsyncPending -- ^ a pending action (that is still running)- deriving (Typeable, Generic)+ deriving (Typeable, Generic, Functor) + instance Serializable a => Binary (AsyncResult a) where deriving instance Eq a => Eq (AsyncResult a) deriving instance Show a => Show (AsyncResult a) +-- | A message to cancel Async operations+data CancelWait = CancelWait+ deriving (Typeable, Generic)+instance Binary CancelWait
tests/TestAsync.hs view
@@ -12,10 +12,10 @@ import Control.Distributed.Process.Serializable() import Control.Distributed.Process.Async import Control.Distributed.Process.Extras (Routable(..), Resolvable(..))-import Control.Distributed.Process.Tests.Internal.Utils+import Control.Distributed.Process.SysTest.Utils import Control.Distributed.Process.Extras.Time import Control.Distributed.Process.Extras.Timer-import Control.Distributed.Process.Tests.Internal.Utils (delayedAssertion)+import Control.Monad (replicateM_) import Data.Binary() import Data.Typeable() import Network.Transport.TCP@@ -35,95 +35,61 @@ ar <- poll hAsync case ar of AsyncPending ->- sendTo hAsync "go" >> wait hAsync >>= stash result+ send (asyncWorker hAsync) "go" >> wait hAsync >>= stash result _ -> stash result ar >> return () +-- Tests that an async action can be canceled. testAsyncCancel :: TestResult (AsyncResult ()) -> Process () testAsyncCancel result = do- hAsync <- async $ task $ runTestProcess $ say "running" >> return ()- sleep $ milliSeconds 100+ hAsync <- async $ task (expect :: Process ()) - p <- poll hAsync -- nasty kind of assertion: use assertEquals?+ p <- poll hAsync case p of AsyncPending -> cancel hAsync >> wait hAsync >>= stash result _ -> say (show p) >> stash result p +-- Tests that cancelWait completes when the worker dies. testAsyncCancelWait :: TestResult (Maybe (AsyncResult ())) -> Process () testAsyncCancelWait result = do- testPid <- getSelfPid- p <- spawnLocal $ do- hAsync <- async $ task $ runTestProcess $ sleep $ seconds 60- sleep $ milliSeconds 100-- send testPid "running"-- AsyncPending <- poll hAsync- cancelWait hAsync >>= send testPid+ hAsync <- async $ task (expect :: Process ()) - "running" <- expect- d <- expectTimeout (asTimeout $ seconds 5)- case d of- Nothing -> kill p "timed out" >> stash result Nothing- Just ar -> stash result (Just ar)+ AsyncPending <- poll hAsync+ cancelWait hAsync >>= stash result . Just +-- Tests that waitTimeout completes when the timeout expires. testAsyncWaitTimeout :: TestResult (Maybe (AsyncResult ())) -> Process ()-testAsyncWaitTimeout result =- let delay = seconds 1- in do- hAsync <- async $ task $ sleep $ seconds 20- waitTimeout delay hAsync >>= stash result+testAsyncWaitTimeout result = do+ hAsync <- async $ task (expect :: Process ())+ waitTimeout 100000 hAsync >>= stash result cancelWait hAsync >> return () +-- Tests that an async action can be awaited to completion even with a timeout. testAsyncWaitTimeoutCompletes :: TestResult (Maybe (AsyncResult ()))- -> Process ()-testAsyncWaitTimeoutCompletes result =- let delay = seconds 1- in do- hAsync <- async $ task $ sleep $ seconds 20- waitTimeout delay hAsync >>= stash result- cancelWait hAsync >> return ()--testAsyncWaitTimeoutSTM :: TestResult (Maybe (AsyncResult ())) -> Process ()-testAsyncWaitTimeoutSTM result =- let delay = seconds 1- in do- hAsync <- async $ task $ sleep $ seconds 20- waitTimeoutSTM delay hAsync >>= stash result--testAsyncWaitTimeoutCompletesSTM :: TestResult (Maybe (AsyncResult Int)) -> Process ()-testAsyncWaitTimeoutCompletesSTM result =- let delay = seconds 1 in do-- hAsync <- async $ task $ do- i <- expect- return i-- r <- waitTimeoutSTM delay hAsync+testAsyncWaitTimeoutCompletes result = do+ hAsync <- async $ task (expect :: Process ())+ r <- waitTimeout 100000 hAsync case r of- Nothing -> sendTo hAsync (10 :: Int)+ Nothing -> send (asyncWorker hAsync) () >> wait hAsync >>= stash result . Just Just _ -> cancelWait hAsync >> stash result Nothing +-- Tests that a linked async action dies when the parent dies. testAsyncLinked :: TestResult Bool -> Process () testAsyncLinked result = do- mv :: MVar (Async ()) <- liftIO $ newEmptyMVar+ mv :: MVar (Async ()) <- liftIO newEmptyMVar pid <- spawnLocal $ do -- NB: async == asyncLinked for AsyncChan- h <- asyncLinked $ task $ do- "waiting" <- expect- return ()+ h <- asyncLinked $ task (expect :: Process ()) stash mv h- "sleeping" <- expect- return ()+ expect hAsync <- liftIO $ takeMVar mv - Just worker <- resolve hAsync- mref <- monitor worker+ mref <- monitorAsync hAsync exit pid "stop" - _ <- receiveTimeout (after 5 Seconds) [+ _ <- receiveWait [ matchIf (\(ProcessMonitorNotification mref' _ _) -> mref == mref') (\_ -> return ()) ]@@ -132,35 +98,43 @@ -- pick up on the exit signal and set the result accordingly. trying to match -- on 'DiedException String' is pointless though, as the *string* is highly -- context dependent.- r <- waitTimeoutSTM (within 3 Seconds) hAsync+ r <- wait hAsync case r of- Nothing -> stash result True- Just _ -> stash result False+ AsyncLinkFailed _ -> stash result True+ _ -> stash result False +-- Tests that waitAny returns when any of the actions complete. testAsyncWaitAny :: TestResult [AsyncResult String] -> Process () testAsyncWaitAny result = do- p1 <- async $ task $ expect >>= return- p2 <- async $ task $ expect >>= return- p3 <- async $ task $ expect >>= return- sendTo p3 "c"+ p1 <- async $ task expect+ p2 <- async $ task expect+ p3 <- async $ task expect+ send (asyncWorker p3) "c" r1 <- waitAny [p1, p2, p3] - sendTo p1 "a"- sendTo p2 "b"- sleep $ seconds 1+ send (asyncWorker p1) "a"+ send (asyncWorker p2) "b"+ ref1 <- monitorAsync p1+ ref2 <- monitorAsync p2+ replicateM_ 2 $ receiveWait+ [ matchIf (\(ProcessMonitorNotification ref _ _) -> elem ref [ref1, ref2])+ $ \_ -> return ()+ ] r2 <- waitAny [p2, p3] r3 <- waitAny [p1, p2, p3] stash result $ map snd [r1, r2, r3] +-- Tests that waitAnyTimeout returns when the timeout expires. testAsyncWaitAnyTimeout :: TestResult (Maybe (AsyncResult String)) -> Process () testAsyncWaitAnyTimeout result = do- p1 <- asyncLinked $ task $ expect >>= return- p2 <- asyncLinked $ task $ expect >>= return- p3 <- asyncLinked $ task $ expect >>= return- waitAnyTimeout (seconds 1) [p1, p2, p3] >>= stash result+ p1 <- asyncLinked $ task expect+ p2 <- asyncLinked $ task expect+ p3 <- asyncLinked $ task expect+ waitAnyTimeout 100000 [p1, p2, p3] >>= stash result +-- Tests that cancelWith terminates the worker with the given reason. testAsyncCancelWith :: TestResult Bool -> Process () testAsyncCancelWith result = do p1 <- async $ task $ do { s :: String <- expect; return s }@@ -168,10 +142,11 @@ AsyncFailed (DiedException _) <- wait p1 stash result True +-- Tests that waitCancelTimeout returns when the timeout expires. testAsyncWaitCancelTimeout :: TestResult (AsyncResult ()) -> Process () testAsyncWaitCancelTimeout result = do- p1 <- async $ task $ sleep $ seconds 20- waitCancelTimeout (seconds 1) p1 >>= stash result+ p1 <- async $ task expect+ waitCancelTimeout 1000000 p1 >>= stash result remotableDecl [ [d| fib :: (NodeId,Int) -> Process Integer ;@@ -185,9 +160,11 @@ return $ y + z |] ]++-- Tests that wait returns when remote actions complete. testAsyncRecursive :: TestResult Integer -> Process () testAsyncRecursive result = do- myNode <- processNodeId <$> getSelfPid+ myNode <- getSelfNode fib (myNode,6) >>= stash result tests :: LocalNode -> [Test]@@ -209,18 +186,10 @@ (delayedAssertion "expected waitTimeout to return Nothing when it times out" localNode (Nothing) testAsyncWaitTimeout)- , testCase "testAsyncWaitTimeoutSTM"- (delayedAssertion- "expected waitTimeoutSTM to return Nothing when it times out"- localNode (Nothing) testAsyncWaitTimeoutSTM) , testCase "testAsyncWaitTimeoutCompletes" (delayedAssertion "expected waitTimeout to return a value"- localNode Nothing testAsyncWaitTimeoutCompletes)- , testCase "testAsyncWaitTimeoutCompletesSTM"- (delayedAssertion- "expected waitTimeout to return a value"- localNode (Just (AsyncDone 10)) testAsyncWaitTimeoutCompletesSTM)+ localNode (Just (AsyncDone ())) testAsyncWaitTimeoutCompletes) , testCase "testAsyncLinked" (delayedAssertion "expected linked process to die with originator"