dda7fda · distributed-process

git.iko.soy/distributed-process

on master help sign in

Implement receiveWait and receiveTimeout

dda7fdaEdsko de Vries14 years ago

distributed-process/distributed-process.cabal+3−3

compare with master

unifiedsplit

@@ -23,7 +23,7 @@ Library

23 Exposed-modules: Control.Distributed.Process,

24 Control.Distributed.Process.Serializable,

25 Control.Distributed.Process.Closure

26− Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell

26+ Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification

27 ghc-options: -Wall

28 HS-Source-Dirs: src

@@ -41,7 +41,7 @@ Test-Suite TestCH

41 ansi-terminal,

42 template-haskell,

43 network-transport >= 0.1

44− Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell

44+ Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification

45 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

46 HS-Source-Dirs: tests src

@@ -61,6 +61,6 @@ Test-Suite TestClosure

61 ansi-terminal,

62 template-haskell,

63 network-transport >= 0.1

64− Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell

64+ Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification

65 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

66 HS-Source-Dirs: tests src

distributed-process/src/Control/Distributed/Process.hs+53−17

@@ -65,6 +65,12 @@ module Control.Distributed.Process

65 , getSelfPid

66 , RemoteCallMetaData

67 , initRemoteCallMetaData

68+ -- * Matching messages

69+ , Match

70+ , match

71+ , matchIf

72+ , receiveWait

73+ , receiveTimeout

68 -- * Monitoring and linking

74 -- * Monitoring and linking

69 , link

75 , link

70 , unlink

76 , unlink

@@ -115,11 +121,11 @@ import Control.Concurrent.MVar ( newMVar

115 , takeMVar

121 , takeMVar

116 )

122 )

117import Control.Concurrent.Chan (newChan, writeChan)

123import Control.Concurrent.Chan (newChan, writeChan)

118−import Control.Distributed.Process.Internal.CQueue ( dequeueMatching

124+import Control.Distributed.Process.Internal.CQueue (enqueue, dequeue, newCQueue)

119− , enqueue

120− , newCQueue

121− )

122−import Control.Distributed.Process.Serializable (Serializable, fingerprint)

125+import Control.Distributed.Process.Serializable ( Serializable

126+ , Fingerprint

127+ , fingerprint

128+ )

123import qualified Network.Transport as NT ( Transport

129import qualified Network.Transport as NT ( Transport

124 , EndPoint

130 , EndPoint

125 , Connection

131 , Connection

@@ -180,12 +186,7 @@ newtype Process a = Process { unProcess :: ReaderT LocalProcess IO a }

180

186

181-- | Wait for a message of a specific type

187-- | Wait for a message of a specific type

182expect :: forall a. Serializable a => Process a

188expect :: forall a. Serializable a => Process a

183−expect = do

189+expect = receiveWait [match return]

184− queue <- processQueue <$> ask

185− let fp = fingerprint (undefined :: a)

186− Just msg <- liftIO $

187− dequeueMatching queue Nothing ((== fp) . messageFingerprint)

188− return (decode . messageEncoding $ msg)

189

190

190-- | Send a message

191-- | Send a message

191send :: Serializable a => ProcessId -> a -> Process ()

192send :: Serializable a => ProcessId -> a -> Process ()

@@ -218,6 +219,46 @@ unmonitor = postCtrlMsg . Unmonitor

218unlink :: ProcessId -> Process ()

219unlink :: ProcessId -> Process ()

219unlink = postCtrlMsg . Unlink

220unlink = postCtrlMsg . Unlink

220

221

222+--------------------------------------------------------------------------------

223+-- Matching --

224+--------------------------------------------------------------------------------

225+

226+data Match b =

227+ forall a. Serializable a => Match Fingerprint (a -> Process b)

228+ | forall a. Serializable a => MatchIf Fingerprint (a -> Bool) (a -> Process b)

229+

230+match :: forall a b. Serializable a => (a -> Process b) -> Match b

231+match = Match (fingerprint (undefined :: a))

232+

233+matchIf :: forall a b. Serializable a => (a -> Bool) -> (a -> Process b) -> Match b

234+matchIf = MatchIf (fingerprint (undefined :: a))

235+

236+receiveWait :: [Match b] -> Process b

237+receiveWait ms = do

238+ queue <- processQueue <$> ask

239+ Just proc <- liftIO $ dequeue queue Nothing (map evalMatch ms)

240+ proc

241+

242+receiveTimeout :: Int -> [Match b] -> Process (Maybe b)

243+receiveTimeout t ms = do

244+ queue <- processQueue <$> ask

245+ mProc <- liftIO $ dequeue queue (Just t) (map evalMatch ms)

246+ case mProc of

247+ Nothing -> return Nothing

248+ Just proc -> Just <$> proc

249+

250+evalMatch :: Match b -> Message -> Maybe (Process b)

251+evalMatch (Match fp proc) msg =

252+ let decoded = decode . messageEncoding $ msg in

253+ if messageFingerprint msg == fp

254+ then Just . proc $ decoded

255+ else Nothing

256+evalMatch (MatchIf fp cond proc) msg =

257+ let decoded = decode . messageEncoding $ msg in

258+ if messageFingerprint msg == fp && cond decoded

259+ then Just . proc $ decoded

260+ else Nothing

261+

221--------------------------------------------------------------------------------

262--------------------------------------------------------------------------------

222-- Auxiliary API --

263-- Auxiliary API --

223--------------------------------------------------------------------------------

264--------------------------------------------------------------------------------

@@ -236,12 +277,7 @@ catch p h = do

236 liftIO $ Exception.catch (run p) (run . h)

277 liftIO $ Exception.catch (run p) (run . h)

237

278

238expectTimeout :: forall a. Serializable a => Int -> Process (Maybe a)

279expectTimeout :: forall a. Serializable a => Int -> Process (Maybe a)

239−expectTimeout timeout = do

280+expectTimeout timeout = receiveTimeout timeout [match return]

240− queue <- processQueue <$> ask

241− let fp = fingerprint (undefined :: a)

242− msg <- liftIO $

243− dequeueMatching queue (Just timeout) ((== fp) . messageFingerprint)

244− return $ fmap (decode . messageEncoding) msg

245

281

246--------------------------------------------------------------------------------

282--------------------------------------------------------------------------------

247-- Initialization --

283-- Initialization --

distributed-process/src/Control/Distributed/Process/Internal/CQueue.hs+34−25

@@ -3,7 +3,7 @@ module Control.Distributed.Process.Internal.CQueue

3 ( CQueue

4 , newCQueue

5 , enqueue

6− , dequeueMatching

6+ , dequeue

7 ) where

9import Control.Concurrent.MVar (MVar, newMVar, modifyMVar)

@@ -23,29 +23,38 @@ newCQueue = do

23enqueue :: CQueue a -> a -> IO ()

24enqueue (CQueue _arrived incoming) = writeChan incoming

26−-- TODO: subtract the timeout value if a non-matching messages arrives

26+dequeue :: forall a b.

27−dequeueMatching :: forall a.

28− CQueue a

27+ CQueue a -- ^ Queue

29− -> Maybe Int

28+ -> Maybe Int -- ^ Timeout

30− -> (a -> Bool)

29+ -> [a -> Maybe b] -- ^ List of matches

31− -> IO (Maybe a)

30+ -> IO (Maybe b) -- ^ Nothing only on timeout

32−dequeueMatching (CQueue arrived incoming) mTimeout matches =

31+dequeue (CQueue arrived incoming) mTimeout matches =

33 modifyMVar arrived (checkArrived [])

32 modifyMVar arrived (checkArrived [])

34 where

33 where

35− checkArrived :: [a] -> [a] -> IO ([a], Maybe a)

34+ checkArrived :: [a] -> [a] -> IO ([a], Maybe b)

36− checkArrived xs' [] = checkIncoming xs'

35+ checkArrived acc (x:xs) =

37− checkArrived xs' (x:xs)

36+ case check x of

38− | matches x = return (reverse xs' ++ xs, Just x)

37+ Just y -> return (reverse acc ++ xs, Just y)

39− | otherwise = checkArrived (x:xs') xs

38+ Nothing -> checkArrived (x:acc) xs

40−

39+ checkArrived acc [] = do

41− checkIncoming :: [a] -> IO ([a], Maybe a)

42− checkIncoming xs' = do

43− mx <- case mTimeout of

40+ result <- case mTimeout of

44− Just 0 -> return Nothing

41+ Nothing -> Just <$> checkIncoming acc

45− Just n -> timeout n $ readChan incoming

42+ Just t -> timeout t $ checkIncoming acc

46− Nothing -> Just <$> readChan incoming

47− case mx of

43+ case result of

48− Nothing -> return (reverse xs', Nothing)

44+ Nothing -> return (reverse acc, Nothing)

49− Just x

50− | matches x -> return (reverse xs', Just x)

45+ Just (acc', b) -> return (reverse acc', Just b)

46+

47+ checkIncoming :: [a] -> IO ([a], b)

51− | otherwise -> checkIncoming (x:xs')

48+ checkIncoming acc = do

49+ x <- readChan incoming

50+ case check x of

51+ Just y -> return (acc, y)

52+ Nothing -> checkIncoming (x:acc)

53+

54+ check :: a -> Maybe b

55+ check = checkMatches matches

56+

57+ checkMatches :: [a -> Maybe b] -> a -> Maybe b

58+ checkMatches [] _ = Nothing

59+ checkMatches (m:ms) a = case m a of Nothing -> checkMatches ms a

60+ Just b -> Just b

distributed-process/tests/TestCH.hs+64−115

@@ -1,10 +1,9 @@

1module Main where

3import Prelude hiding (catch)

4−import Data.Binary (Binary)

4+import Data.Binary (Binary(..))

5import Data.Typeable (Typeable)

6import Data.Foldable (forM_)

7−import qualified Data.Map as Map (empty)

8import Control.Concurrent (forkIO, threadDelay)

7import Control.Concurrent (forkIO, threadDelay)

9import Control.Concurrent.MVar ( MVar

8import Control.Concurrent.MVar ( MVar

10 , newEmptyMVar

9 , newEmptyMVar

@@ -15,7 +14,7 @@ import Control.Concurrent.MVar ( MVar

15import Control.Monad (replicateM_)

14import Control.Monad (replicateM_)

16import Control.Monad.IO.Class (liftIO)

15import Control.Monad.IO.Class (liftIO)

17import Control.Exception (throwIO)

16import Control.Exception (throwIO)

18−import Control.Applicative ((<$>))

17+import Control.Applicative ((<$>), (<*>))

19import qualified Network.Transport as NT (Transport, closeEndPoint)

18import qualified Network.Transport as NT (Transport, closeEndPoint)

20import Network.Transport.TCP (createTransport, defaultTCPParameters)

19import Network.Transport.TCP (createTransport, defaultTCPParameters)

21import Control.Distributed.Process

20import Control.Distributed.Process

@@ -44,13 +43,13 @@ testPing transport = do

45 -- Server

44 -- Server

46 forkIO $ do

45 forkIO $ do

47− localNode <- newLocalNode transport Map.empty

46+ localNode <- newLocalNode transport initRemoteCallMetaData

48 addr <- forkProcess localNode ping

47 addr <- forkProcess localNode ping

49 putMVar serverAddr addr

48 putMVar serverAddr addr

51 -- Client

50 -- Client

52 forkIO $ do

51 forkIO $ do

53− localNode <- newLocalNode transport Map.empty

52+ localNode <- newLocalNode transport initRemoteCallMetaData

54 pingServer <- readMVar serverAddr

53 pingServer <- readMVar serverAddr

56 let numPings = 10000

55 let numPings = 10000

@@ -118,13 +117,13 @@ testMonitorUnreachable transport mOrL un = do

118 done <- newEmptyMVar

117 done <- newEmptyMVar

119

118

120 forkIO $ do

119 forkIO $ do

121− localNode <- newLocalNode transport Map.empty

120+ localNode <- newLocalNode transport initRemoteCallMetaData

122 addr <- forkProcess localNode . liftIO $ threadDelay 1000000

121 addr <- forkProcess localNode . liftIO $ threadDelay 1000000

123 closeLocalNode localNode

122 closeLocalNode localNode

124 putMVar deadProcess addr

123 putMVar deadProcess addr

125

124

126 forkIO $ do

125 forkIO $ do

127− localNode <- newLocalNode transport Map.empty

126+ localNode <- newLocalNode transport initRemoteCallMetaData

128 theirAddr <- readMVar deadProcess

127 theirAddr <- readMVar deadProcess

129 runProcess localNode $

128 runProcess localNode $

130 monitorTestProcess theirAddr mOrL un DiedDisconnect Nothing done

129 monitorTestProcess theirAddr mOrL un DiedDisconnect Nothing done

@@ -139,13 +138,13 @@ testMonitorNormalTermination transport mOrL un = do

139 done <- newEmptyMVar

138 done <- newEmptyMVar

140

139

141 forkIO $ do

140 forkIO $ do

142− localNode <- newLocalNode transport Map.empty

141+ localNode <- newLocalNode transport initRemoteCallMetaData

143 addr <- forkProcess localNode $

142 addr <- forkProcess localNode $

144 liftIO $ readMVar monitorSetup

143 liftIO $ readMVar monitorSetup

145 putMVar monitoredProcess addr

144 putMVar monitoredProcess addr

146

145

147 forkIO $ do

146 forkIO $ do

148− localNode <- newLocalNode transport Map.empty

147+ localNode <- newLocalNode transport initRemoteCallMetaData

149 theirAddr <- readMVar monitoredProcess

148 theirAddr <- readMVar monitoredProcess

150 runProcess localNode $

149 runProcess localNode $

151 monitorTestProcess theirAddr mOrL un DiedNormal (Just monitorSetup) done

150 monitorTestProcess theirAddr mOrL un DiedNormal (Just monitorSetup) done

@@ -162,14 +161,14 @@ testMonitorAbnormalTermination transport mOrL un = do

162 let err = userError "Abnormal termination"

161 let err = userError "Abnormal termination"

163

162

164 forkIO $ do

163 forkIO $ do

165− localNode <- newLocalNode transport Map.empty

164+ localNode <- newLocalNode transport initRemoteCallMetaData

166 addr <- forkProcess localNode . liftIO $ do

165 addr <- forkProcess localNode . liftIO $ do

167 readMVar monitorSetup

166 readMVar monitorSetup

168 throwIO err

167 throwIO err

169 putMVar monitoredProcess addr

168 putMVar monitoredProcess addr

170

169

171 forkIO $ do

170 forkIO $ do

172− localNode <- newLocalNode transport Map.empty

171+ localNode <- newLocalNode transport initRemoteCallMetaData

173 theirAddr <- readMVar monitoredProcess

172 theirAddr <- readMVar monitoredProcess

174 runProcess localNode $

173 runProcess localNode $

175 monitorTestProcess theirAddr mOrL un (DiedException (show err)) (Just monitorSetup) done

174 monitorTestProcess theirAddr mOrL un (DiedException (show err)) (Just monitorSetup) done

@@ -181,7 +180,7 @@ testMonitorLocalDeadProcess :: NT.Transport -> Bool -> Bool -> IO ()

181testMonitorLocalDeadProcess transport mOrL un = do

180testMonitorLocalDeadProcess transport mOrL un = do

182 processDead <- newEmptyMVar

181 processDead <- newEmptyMVar

183 processAddr <- newEmptyMVar

182 processAddr <- newEmptyMVar

184− localNode <- newLocalNode transport Map.empty

183+ localNode <- newLocalNode transport initRemoteCallMetaData

185 done <- newEmptyMVar

184 done <- newEmptyMVar

186

185

187 forkIO $ do

186 forkIO $ do

@@ -204,12 +203,12 @@ testMonitorRemoteDeadProcess transport mOrL un = do

204 done <- newEmptyMVar

203 done <- newEmptyMVar

205

204

206 forkIO $ do

205 forkIO $ do

207− localNode <- newLocalNode transport Map.empty

206+ localNode <- newLocalNode transport initRemoteCallMetaData

208 addr <- forkProcess localNode . liftIO $ putMVar processDead ()

207 addr <- forkProcess localNode . liftIO $ putMVar processDead ()

209 putMVar processAddr addr

208 putMVar processAddr addr

210

209

211 forkIO $ do

210 forkIO $ do

212− localNode <- newLocalNode transport Map.empty

211+ localNode <- newLocalNode transport initRemoteCallMetaData

213 theirAddr <- readMVar processAddr

212 theirAddr <- readMVar processAddr

214 readMVar processDead

213 readMVar processDead

215 runProcess localNode $ do

214 runProcess localNode $ do

@@ -225,128 +224,83 @@ testMonitorDisconnect transport mOrL un = do

225 done <- newEmptyMVar

224 done <- newEmptyMVar

226

225

227 forkIO $ do

226 forkIO $ do

228− localNode <- newLocalNode transport Map.empty

227+ localNode <- newLocalNode transport initRemoteCallMetaData

229 addr <- forkProcess localNode . liftIO $ threadDelay 1000000

228 addr <- forkProcess localNode . liftIO $ threadDelay 1000000

230 putMVar processAddr addr

229 putMVar processAddr addr

231 readMVar monitorSetup

230 readMVar monitorSetup

232 NT.closeEndPoint (localEndPoint localNode)

231 NT.closeEndPoint (localEndPoint localNode)

233

232

234 forkIO $ do

233 forkIO $ do

235− localNode <- newLocalNode transport Map.empty

234+ localNode <- newLocalNode transport initRemoteCallMetaData

236 theirAddr <- readMVar processAddr

235 theirAddr <- readMVar processAddr

237 runProcess localNode $ do

236 runProcess localNode $ do

238 monitorTestProcess theirAddr mOrL un DiedDisconnect (Just monitorSetup) done

237 monitorTestProcess theirAddr mOrL un DiedDisconnect (Just monitorSetup) done

239

238

240 takeMVar done

239 takeMVar done

241

240

241+data Add = Add ProcessId Double Double deriving (Typeable)

242+data Divide = Divide ProcessId Double Double deriving (Typeable)

243+data DivByZero = DivByZero deriving (Typeable)

244+

245+instance Binary Add where

246+ put (Add pid x y) = put pid >> put x >> put y

247+ get = Add <$> get <*> get <*> get

248+

249+instance Binary Divide where

250+ put (Divide pid x y) = put pid >> put x >> put y

251+ get = Divide <$> get <*> get <*> get

252+

253+instance Binary DivByZero where

254+ put DivByZero = return ()

255+ get = return DivByZero

256+

257+math :: Process ()

258+math = do

259+ receiveWait

260+ [ match (\(Add pid x y) -> send pid (x + y))

261+ , matchIf (\(Divide _ _ y) -> y /= 0)

262+ (\(Divide pid x y) -> send pid (x / y))

263+ , match (\(Divide pid _ _) -> send pid DivByZero)

264+ ]

265+ math

242

266

243−{-

267+-- | Test the math server (i.e., receiveWait)

244−-- Like 'testMonitor1', but throw an exception instead

245−testMonitor2 :: NT.Transport -> IO ()

246−testMonitor2 transport = do

247− deadProcess <- newEmptyMVar

248− done <- newEmptyMVar

249−

250− forkIO $ do

251− localNode <- newLocalNode transport Map.empty

252− addr <- forkProcess localNode $ return ()

253− closeLocalNode localNode

254− putMVar deadProcess addr

255−

256− forkIO $ do

257− localNode <- newLocalNode transport Map.empty

258− theirAddr <- readMVar deadProcess

259− runProcess localNode $ do

260− monitor theirAddr MaLink

261− pcatch (send theirAddr "Hi") $ \(ProcessMonitorException pid SrNoPing) -> do

262− True <- return $ pid == theirAddr

263− return ()

264− putMVar done ()

265−

266− takeMVar done

267−

268−-- The first send succeeds, connection is set up, but then the second send

269−-- fails.

270−--

271−-- TODO: should we specify that we receive exactly one notification per process

272−-- failure?

273−testMonitor3 :: NT.Transport -> IO ()

268+testMath :: NT.Transport -> IO ()

274−testMonitor3 transport = do

269+testMath transport = do

275− firstSend <- newEmptyMVar

276− serverAddr <- newEmptyMVar

270+ serverAddr <- newEmptyMVar

277− serverDead <- newEmptyMVar

278− done <- newEmptyMVar

271+ clientDone <- newEmptyMVar

279

272

273+ -- Server

280 forkIO $ do

274 forkIO $ do

281− localNode <- newLocalNode transport Map.empty

275+ localNode <- newLocalNode transport initRemoteCallMetaData

282− -- TODO: what happens when processes terminate?

283− addr <- forkProcess localNode $ return ()

276+ addr <- forkProcess localNode math

284 putMVar serverAddr addr

277 putMVar serverAddr addr

285− readMVar firstSend

286− closeLocalNode localNode

287− threadDelay 10000 -- Give the TCP layer a chance to actually close the socket

288− putMVar serverDead ()

289

278

279+ -- Client

290 forkIO $ do

280 forkIO $ do

291− localNode <- newLocalNode transport Map.empty

281+ localNode <- newLocalNode transport initRemoteCallMetaData

292− theirAddr <- readMVar serverAddr

282+ mathServer <- readMVar serverAddr

293− runProcess localNode $ do

294− monitor theirAddr MaMonitor

295− send theirAddr "Hi"

296− liftIO $ putMVar firstSend () >> readMVar serverDead

297− send theirAddr "Ho"

298− ProcessMonitorException pid SrNoPing <- expect

299− True <- return $ pid == theirAddr

300− -- We should not receive a second exception

301− send theirAddr "Hey"

302− Nothing <- expectTimeout 1000000 :: Process (Maybe ProcessMonitorException)

303− return ()

304− putMVar done ()

305−

306− takeMVar done

307−

308−

309−-- Like testMonitor3, except without the second send (so we must detect the

310−-- failure elsewhere)

311−testMonitor4 :: NT.Transport -> IO ()

312−testMonitor4 transport = do

313− firstSend <- newEmptyMVar

314− serverAddr <- newEmptyMVar

315− serverDead <- newEmptyMVar

316− done <- newEmptyMVar

317

283

318− forkIO $ do

284+ runProcess localNode $ do

319− localNode <- newLocalNode transport Map.empty

285+ pid <- getSelfPid

320− -- TODO: what happens when processes terminate?

286+ send mathServer (Add pid 1 2)

321− addr <- forkProcess localNode $ return ()

287+ 3 <- expect :: Process Double

322− putMVar serverAddr addr

288+ send mathServer (Divide pid 8 2)

323− readMVar firstSend

289+ 4 <- expect :: Process Double

324− closeLocalNode localNode

290+ send mathServer (Divide pid 8 0)

325− threadDelay 10000 -- Give the TCP layer a chance to actually close the socket

291+ DivByZero <- expect

326− putMVar serverDead ()

292+ liftIO $ putMVar clientDone ()

327

293

328− forkIO $ do

329− localNode <- newLocalNode transport Map.empty

330− theirAddr <- readMVar serverAddr

331− runProcess localNode $ do

332− monitor theirAddr MaMonitor

333− send theirAddr "Hi"

334− liftIO $ putMVar firstSend () >> readMVar serverDead

335− ProcessMonitorException pid SrNoPing <- expect

336− True <- return $ pid == theirAddr

337− return ()

338− putMVar done ()

339−

340− takeMVar done

294+ takeMVar clientDone

341

295

342−-- TODO: test/specify normal process termination

296+-- TODO: test timeout

343−-}

344

297

345main :: IO ()

298main :: IO ()

346main = do

299main = do

347 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters

300 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters

348 runTests

301 runTests

349− [ ("Ping", testPing transport)

302+ [ ("Ping", testPing transport)

303+ , ("Math", testMath transport)

350 -- The "missing" combinations in the list below don't make much sense, as

304 -- The "missing" combinations in the list below don't make much sense, as

351 -- we cannot guarantee that the monitor reply or link exception will not

305 -- we cannot guarantee that the monitor reply or link exception will not

352 -- happen before the unmonitor or unlink

306 -- happen before the unmonitor or unlink

@@ -368,9 +322,4 @@ main = do

368 , ("UnlinkNormalTermination", testMonitorNormalTermination transport False True)

322 , ("UnlinkNormalTermination", testMonitorNormalTermination transport False True)

369 , ("UnlinkAbnormalTermination", testMonitorAbnormalTermination transport False True)

323 , ("UnlinkAbnormalTermination", testMonitorAbnormalTermination transport False True)

370 , ("UnlinkDisconnect", testMonitorDisconnect transport False True)

324 , ("UnlinkDisconnect", testMonitorDisconnect transport False True)

371− {-

372− , ("Monitor2", testMonitor2 transport)

373− , ("Monitor3", testMonitor3 transport)

374− , ("Monitor4", testMonitor4 transport)

375− -}

376 ]

325 ]