@@ -77,7 +77,6 @@ testSpawnTracing result = do
7777 evSpawned <- liftIO $ newEmptyMVar
7878 evDied <- liftIO $ newEmptyMVar
7979 tracer <- startTracer $ \ev -> do
80− say "in spawn tracer..."
8180 case ev of
8281 (TraceEvSpawned p) -> liftIO $ putMVar evSpawned p
8382 (TraceEvDied p r) -> liftIO $ putMVar evDied (p, r)
@@ -96,9 +95,7 @@ testSpawnTracing result = do
9695 matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mref)
9796 ((\_ -> return ()))
9897 ]
99− say "seen the death of tracer"
10098 setTraceFlags defaultTraceFlags
101− say "finishing setting default flags"
10299 stash result (tracedAlive == pid &&
103100 tracedDead == pid &&
104101 tracedReason == DiedNormal)
@@ -146,6 +143,79 @@ testTraceRecvNamedPid result = do
146143 stash result (res' && (p == pid))
147144 return ()
148145
146+testTraceSending :: TestResult Bool -> Process ()
147+testTraceSending result = do
148+ pid <- spawnLocal $ (expect :: Process String) >> return ()
149+ self <- getSelfPid
150+ res <- liftIO $ newEmptyMVar
151+ withFlags defaultTraceFlags { traceSend = traceOn } $ do
152+ withTracer
153+ (\ev ->
154+ case ev of
155+ (TraceEvSent to from _) ->
156+ stash res (to == pid && from == self)
157+ _ ->
158+ return ()) $ do
159+ send pid "hello there"
160+ res' <- liftIO $ takeMVar res
161+ stash result res'
162+
163+testTraceRegistration :: TestResult Bool -> Process ()
164+testTraceRegistration result = do
165+ (sp, rp) <- newChan
166+ pid <- spawnLocal $ do
167+ self <- getSelfPid
168+ () <- expect
169+ register "foobar" self
170+ sendChan sp ()
171+ () <- expect
172+ return ()
173+ res <- liftIO $ newEmptyMVar
174+ withFlags defaultTraceFlags { traceRegistered = traceOn } $ do
175+ withTracer
176+ (\ev ->
177+ case ev of
178+ TraceEvRegistered p s ->
179+ stash res (p == pid && s == "foobar")
180+ _ ->
181+ return ()) $ do
182+ _ <- monitor pid
183+ send pid ()
184+ () <- receiveChan rp
185+ send pid ()
186+ receiveWait [
187+ match (\(ProcessMonitorNotification _ _ _) -> return ())
188+ ]
189+ res' <- liftIO $ takeMVar res
190+ stash result res'
191+
192+testTraceUnRegistration :: TestResult Bool -> Process ()
193+testTraceUnRegistration result = do
194+ pid <- spawnLocal $ do
195+ () <- expect
196+ unregister "foobar"
197+ () <- expect
198+ return ()
199+ register "foobar" pid
200+ res <- liftIO $ newEmptyMVar
201+ withFlags defaultTraceFlags { traceUnregistered = traceOn } $ do
202+ withTracer
203+ (\ev ->
204+ case ev of
205+ TraceEvUnRegistered p n -> do
206+ stash res (p == pid && n == "foobar")
207+ send pid ()
208+ _ ->
209+ return ()) $ do
210+ mref <- monitor pid
211+ send pid ()
212+ receiveWait [
213+ matchIf (\(ProcessMonitorNotification mref' _ _) -> mref == mref')
214+ (\_ -> return ())
215+ ]
216+ res' <- liftIO $ takeMVar res
217+ stash result res'
218+
149219testTraceLayering :: TestResult () -> Process ()
150220testTraceLayering result = do
151221 pid <- spawnLocal $ do
@@ -154,8 +224,8 @@ testTraceLayering result = do
154224 traceMessage ("traceMsg", 123 :: Int)
155225 return ()
156226 withFlags defaultTraceFlags {
157− traceDied = traceOnly [pid]
158− , traceRecv = traceOnly ["foobar"]
227+ traceDied = traceOnly [pid]
228+ , traceRecv = traceOnly ["foobar"]
159229 } $ doTest pid result
160230 return ()
161231 where
@@ -171,22 +241,22 @@ testTraceLayering result = do
171241 ( do {
172242 recv <- liftIO $ newEmptyMVar
173243 ; withTracer
174− (\ev' ->
175− case ev' of
176− TraceEvReceived _ _ -> liftIO $ putMVar recv ()
177− _ -> return ())
178− ( do {
179− user <- liftIO $ newEmptyMVar
180− ; withTracer
181− (\ev'' ->
182− case ev'' of
183− TraceEvUser _ -> liftIO $ putMVar user ()
184− _ -> return ())
185− (send pid () >> (liftIO $ takeMVar user))
186− ; liftIO $ takeMVar recv
187− })
188− ; liftIO $ takeMVar died
189− })
244+ (\ev' ->
245+ case ev' of
246+ TraceEvReceived _ _ -> liftIO $ putMVar recv ()
247+ _ -> return ())
248+ ( do {
249+ user <- liftIO $ newEmptyMVar
250+ ; withTracer
251+ (\ev'' ->
252+ case ev'' of
253+ TraceEvUser _ -> liftIO $ putMVar user ()
254+ _ -> return ())
255+ (send pid () >> (liftIO $ takeMVar user))
256+ ; liftIO $ takeMVar recv
257+ })
258+ ; liftIO $ takeMVar died
259+ })
190260 liftIO $ putMVar result' ()
191261
192262tests :: LocalNode -> IO [Test]
@@ -212,6 +282,18 @@ tests node1 = do
212282 (delayedAssertion
213283 "expected a recv trace for the process registered as 'foobar'"
214284 node1 True testTraceRecvNamedPid lock)
285+ , testCase "Trace Send(er)"
286+ (delayedAssertion
287+ "expected a 'send' trace with the requisite fields set"
288+ node1 True testTraceSending lock)
289+ , testCase "Trace Registration"
290+ (delayedAssertion
291+ "expected a 'registered' trace"
292+ node1 True testTraceRegistration lock)
293+ , testCase "Trace Unregistration"
294+ (delayedAssertion
295+ "expected an 'unregistered' trace"
296+ node1 True testTraceUnRegistration lock)
215297 , testCase "Trace Layering"
216298 (delayedAssertion
217299 "expected blah"