git.iko.soy/distributed-process
on master help sign in
d-p-tests: Make ReceiveChanTimeout time-insensitive.
commit1a57d4616be0580c07587c564f5f9774738df3dd authorFacundo Domínguez <facundo.dominguez@tweag.io> dateFri 19 Aug 2016, 09:47 (10 years ago) parent9a8fcf5
1 file changed+24−9
distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+24−9
distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+24−9
@@ -1081,6 +1081,7 @@ testMatchMessageWithUnwrap TestTransport{..} = do
10811081testReceiveChanTimeout :: TestTransport -> Assertion
10821082testReceiveChanTimeout TestTransport{..} = do
10831083 done <- newEmptyMVar
1084+ mvSender <- newEmptyMVar
10841085 sendPort <- newEmptyMVar
10851086
10861087 forkTry $ do
@@ -1090,18 +1091,31 @@ testReceiveChanTimeout TestTransport{..} = do
10901091 (sp, rp) <- newChan :: Process (SendPort Bool, ReceivePort Bool)
10911092 liftIO $ putMVar sendPort sp
10921093
1093− -- Wait for a message with a delay. No message arrives, we should get Nothing after 1 second
1094− Nothing <- receiveChanTimeout 1000000 rp
1094+ -- Wait for a message with a delay. No message arrives, we should get
1095+ -- Nothing after the delay.
1096+ Nothing <- receiveChanTimeout 100000 rp
10951097
1096− -- Wait for a message with a delay again. Now a message arrives after 0.5 seconds
1097− Just True <- receiveChanTimeout 1000000 rp
1098+ -- Let the sender know that it can send a message.
1099+ liftIO $ putMVar mvSender ()
10981100
1099− -- Wait for a message with zero timeout: non-blocking check. No message is available, we get Nothing
1101+ -- Wait for a message with a delay again. Now a message arrives after
1102+ -- 0.1 seconds
1103+ Just True <- receiveChanTimeout 20000000 rp
1104+
1105+ -- Wait for a message with zero timeout: non-blocking check. No message is
1106+ -- available, we get Nothing
11001107 Nothing <- receiveChanTimeout 0 rp
11011108
1109+ -- Let the sender know that it can send a message.
1110+ liftIO $ putMVar mvSender ()
1111+
11021112 -- Again, but now there is a message available
1103− liftIO $ threadDelay 1000000
1104− Just False <- receiveChanTimeout 0 rp
1113+ fix $ \loop -> do
1114+ liftIO $ threadDelay 100000
1115+ mb <- receiveChanTimeout 0 rp
1116+ case mb of
1117+ Just b -> do False <- return b; return ()
1118+ _ -> loop
11051119
11061120 liftIO $ putMVar done ()
11071121
@@ -1110,10 +1124,11 @@ testReceiveChanTimeout TestTransport{..} = do
11101124 runProcess localNode $ do
11111125 sp <- liftIO $ readMVar sendPort
11121126
1113− liftIO $ threadDelay 1500000
1127+ liftIO $ takeMVar mvSender
1128+ liftIO $ threadDelay 100000
11141129 sendChan sp True
11151130
1116− liftIO $ threadDelay 500000
1131+ liftIO $ takeMVar mvSender
11171132 sendChan sp False
11181133
11191134 takeMVar done