git.iko.soy/distributed-process
on master help sign in
d-p-tests: Make ReceiveChanTimeout time-insensitive.
1a57d46Facundo Domínguez
distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+24−9
compare with master
unifiedsplit
@@ -1081,6 +1081,7 @@ testMatchMessageWithUnwrap TestTransport{..} = do
1081testReceiveChanTimeout :: TestTransport -> Assertion
1081testReceiveChanTimeout :: TestTransport -> Assertion
1082testReceiveChanTimeout TestTransport{..} = do
1082testReceiveChanTimeout TestTransport{..} = do
1083 done <- newEmptyMVar
1083 done <- newEmptyMVar
1084+ mvSender <- newEmptyMVar
1084 sendPort <- newEmptyMVar
1085 sendPort <- newEmptyMVar
1085
1086
1086 forkTry $ do
1087 forkTry $ do
@@ -1090,18 +1091,31 @@ testReceiveChanTimeout TestTransport{..} = do
1090 (sp, rp) <- newChan :: Process (SendPort Bool, ReceivePort Bool)
1091 (sp, rp) <- newChan :: Process (SendPort Bool, ReceivePort Bool)
1091 liftIO $ putMVar sendPort sp
1092 liftIO $ putMVar sendPort sp
1092
1093
1093− -- Wait for a message with a delay. No message arrives, we should get Nothing after 1 second
1094+ -- Wait for a message with a delay. No message arrives, we should get
1095+ -- Nothing after the delay.
1094− Nothing <- receiveChanTimeout 1000000 rp
1096+ Nothing <- receiveChanTimeout 100000 rp
1095
1097
1096− -- Wait for a message with a delay again. Now a message arrives after 0.5 seconds
1098+ -- Let the sender know that it can send a message.
1097− Just True <- receiveChanTimeout 1000000 rp
1099+ liftIO $ putMVar mvSender ()
1098
1100
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+
1099− -- Wait for a message with zero timeout: non-blocking check. No message is available, we get Nothing
1105+ -- Wait for a message with zero timeout: non-blocking check. No message is
1106+ -- available, we get Nothing
1100 Nothing <- receiveChanTimeout 0 rp
1107 Nothing <- receiveChanTimeout 0 rp
1101
1108
1109+ -- Let the sender know that it can send a message.
1110+ liftIO $ putMVar mvSender ()
1111+
1102 -- Again, but now there is a message available
1112 -- Again, but now there is a message available
1113+ fix $ \loop -> do
1103− liftIO $ threadDelay 1000000
1114+ liftIO $ threadDelay 100000
1104− Just False <- receiveChanTimeout 0 rp
1115+ mb <- receiveChanTimeout 0 rp
1116+ case mb of
1117+ Just b -> do False <- return b; return ()
1118+ _ -> loop
1105
1119
1106 liftIO $ putMVar done ()
1120 liftIO $ putMVar done ()
1107
1121
@@ -1110,10 +1124,11 @@ testReceiveChanTimeout TestTransport{..} = do
1110 runProcess localNode $ do
1124 runProcess localNode $ do
1111 sp <- liftIO $ readMVar sendPort
1125 sp <- liftIO $ readMVar sendPort
1112
1126
1127+ liftIO $ takeMVar mvSender
1113− liftIO $ threadDelay 1500000
1128+ liftIO $ threadDelay 100000
1114 sendChan sp True
1129 sendChan sp True
1115
1130
1116− liftIO $ threadDelay 500000
1131+ liftIO $ takeMVar mvSender
1117 sendChan sp False
1132 sendChan sp False
1118
1133
1119 takeMVar done
1134 takeMVar done