packages feed

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 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"