54ed63c · distributed-process

git.iko.soy/distributed-process

on master help sign in

Make testCloseTransport more robust

54ed63cEdsko de Vries14 years ago

network-transport/src/Network/Transport.hs+12−8

compare with master

unifiedsplit

@@ -77,7 +77,7 @@ data Event =

77 | EndPointClosed

78 -- | An error occurred

79 | ErrorEvent (TransportError EventErrorCode)

80− deriving Show

80+ deriving (Show, Eq)

82-- | Connection data ConnectHintsIDs enable receivers to distinguish one connection from another.

83type ConnectionId = Int

@@ -87,7 +87,7 @@ data Reliability =

87 ReliableOrdered

88 | ReliableUnordered

89 | Unreliable

90− deriving Show

90+ deriving (Show, Eq)

92-- | Multicast group.

93data MulticastGroup = MulticastGroup {

@@ -154,13 +154,17 @@ data TransportError error = TransportError error String

154-- exceptions.

155instance (Typeable err, Show err) => Exception (TransportError err)

156

157+-- | When comparing errors we ignore the human-readable strings

158+instance Eq error => Eq (TransportError error) where

159+ TransportError err1 _ == TransportError err2 _ = err1 == err2

160+

157-- | Errors during the creation of an endpoint

161-- | Errors during the creation of an endpoint

158data NewEndPointErrorCode =

162data NewEndPointErrorCode =

159 -- | Not enough resources

163 -- | Not enough resources

160 NewEndPointInsufficientResources

164 NewEndPointInsufficientResources

161 -- | Failed for some other reason

165 -- | Failed for some other reason

162 | NewEndPointFailed

166 | NewEndPointFailed

163− deriving (Show, Typeable)

167+ deriving (Show, Typeable, Eq)

164

168

165-- | Connection failure

169-- | Connection failure

166data ConnectErrorCode =

170data ConnectErrorCode =

@@ -170,7 +174,7 @@ data ConnectErrorCode =

170 | ConnectInsufficientResources

174 | ConnectInsufficientResources

171 -- | Failed for other reasons (including syntax error)

175 -- | Failed for other reasons (including syntax error)

172 | ConnectFailed

176 | ConnectFailed

173− deriving (Show, Typeable)

177+ deriving (Show, Typeable, Eq)

174

178

175-- | Failure during the creation of a new multicast group

179-- | Failure during the creation of a new multicast group

176data NewMulticastGroupErrorCode =

180data NewMulticastGroupErrorCode =

@@ -180,7 +184,7 @@ data NewMulticastGroupErrorCode =

180 | NewMulticastGroupFailed

184 | NewMulticastGroupFailed

181 -- | Not all transport implementations support multicast

185 -- | Not all transport implementations support multicast

182 | NewMulticastGroupUnsupported

186 | NewMulticastGroupUnsupported

183− deriving (Show, Typeable)

187+ deriving (Show, Typeable, Eq)

184

188

185-- | Failure during the resolution of a multicast group

189-- | Failure during the resolution of a multicast group

186data ResolveMulticastGroupErrorCode =

190data ResolveMulticastGroupErrorCode =

@@ -190,7 +194,7 @@ data ResolveMulticastGroupErrorCode =

190 | ResolveMulticastGroupFailed

194 | ResolveMulticastGroupFailed

191 -- | Not all transport implementations support multicast

195 -- | Not all transport implementations support multicast

192 | ResolveMulticastGroupUnsupported

196 | ResolveMulticastGroupUnsupported

193− deriving (Show, Typeable)

197+ deriving (Show, Typeable, Eq)

194

198

195-- | Failure during sending a message

199-- | Failure during sending a message

196data SendErrorCode =

200data SendErrorCode =

@@ -198,7 +202,7 @@ data SendErrorCode =

198 SendClosed

202 SendClosed

199 -- | Send failed for some other reason

203 -- | Send failed for some other reason

200 | SendFailed

204 | SendFailed

201− deriving (Show, Typeable)

205+ deriving (Show, Typeable, Eq)

202

206

203-- | Error codes used when reporting errors to endpoints (through receive)

207-- | Error codes used when reporting errors to endpoints (through receive)

204data EventErrorCode =

208data EventErrorCode =

@@ -208,4 +212,4 @@ data EventErrorCode =

208 | EventTransportFailed

212 | EventTransportFailed

209 -- | Connection to a remote endpoint was lost

213 -- | Connection to a remote endpoint was lost

210 | EventConnectionLost EndPointAddress [ConnectionId]

214 | EventConnectionLost EndPointAddress [ConnectionId]

211− deriving Show

215+ deriving (Show, Typeable, Eq)

network-transport/tests/TestTransport.hs+8−4

@@ -19,6 +19,7 @@ import Data.Map (Map)

19import qualified Data.Map as Map (empty, insert, delete, findWithDefault, adjust, null, toList, map)

20import Data.String (fromString)

21import Data.Maybe (catMaybes)

22+import Data.List (permutations)

22import Traced

23import Traced

24-- | We overload connect to always pass the default hints

25-- | We overload connect to always pass the default hints

@@ -679,10 +680,13 @@ testCloseTransport newTransport = do

679 Right conn <- connect endpoint theirAddr2 ReliableOrdered

680 Right conn <- connect endpoint theirAddr2 ReliableOrdered

680 send conn ["pong"]

681 send conn ["pong"]

681

682

682− -- Client now closes down its transport. We should receive connection closed messages

683+ -- Client now closes down its transport. We should receive connection closed messages (we don't know the precise order, however)

683− ConnectionClosed cid' <- receive endpoint ; True <- return $ cid' == cid1 || cid' == cid2

684+ evs <- replicateM 3 $ receive endpoint

684− ConnectionClosed cid'' <- receive endpoint ; True <- return $ (cid'' == cid1 || cid'' == cid2) && cid'' /= cid'

685+ let expected = [ ConnectionClosed cid1

686+ , ConnectionClosed cid2

685− ErrorEvent (TransportError (EventConnectionLost addr'' []) _) <- receive endpoint ; True <- return $ addr'' == theirAddr2

687+ , ErrorEvent (TransportError (EventConnectionLost theirAddr2 []) "")

688+ ]

689+ True <- return $ any (== expected) (permutations evs)

686

690

687 -- An attempt to send to the endpoint should now fail

691 -- An attempt to send to the endpoint should now fail

688 Left (TransportError SendFailed _) <- send conn ["pong2"]

692 Left (TransportError SendFailed _) <- send conn ["pong2"]