54ed63c · distributed-process

git.iko.soy/distributed-process

Make testCloseTransport more robust

(We relied on getting events in a certain order)

commit54ed63cf0dd2ae5898f4d5c430f744ba4c317a2b authorEdsko de Vries <edsko@edsko.net> dateWed 30 May 2012, 13:30 (14 years ago) parent08ac22b

2 files changed+20−12

compare with master

unifiedsplit

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

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

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

7777 | EndPointClosed

7878 -- | An error occurred

7979 | ErrorEvent (TransportError EventErrorCode)

80− deriving Show

80+ deriving (Show, Eq)

8181

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

8383type ConnectionId = Int

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

8787 ReliableOrdered

8888 | ReliableUnordered

8989 | Unreliable

90− deriving Show

90+ deriving (Show, Eq)

9191

9292-- | Multicast group.

9393data MulticastGroup = MulticastGroup {

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

154154-- exceptions.

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

156156

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+

157161-- | Errors during the creation of an endpoint

158162data NewEndPointErrorCode =

159163 -- | Not enough resources

160164 NewEndPointInsufficientResources

161165 -- | Failed for some other reason

162166 | NewEndPointFailed

163− deriving (Show, Typeable)

167+ deriving (Show, Typeable, Eq)

164168

165169-- | Connection failure

166170data ConnectErrorCode =

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

170174 | ConnectInsufficientResources

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

172176 | ConnectFailed

173− deriving (Show, Typeable)

177+ deriving (Show, Typeable, Eq)

174178

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

176180data NewMulticastGroupErrorCode =

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

180184 | NewMulticastGroupFailed

181185 -- | Not all transport implementations support multicast

182186 | NewMulticastGroupUnsupported

183− deriving (Show, Typeable)

187+ deriving (Show, Typeable, Eq)

184188

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

186190data ResolveMulticastGroupErrorCode =

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

190194 | ResolveMulticastGroupFailed

191195 -- | Not all transport implementations support multicast

192196 | ResolveMulticastGroupUnsupported

193− deriving (Show, Typeable)

197+ deriving (Show, Typeable, Eq)

194198

195199-- | Failure during sending a message

196200data SendErrorCode =

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

198202 SendClosed

199203 -- | Send failed for some other reason

200204 | SendFailed

201− deriving (Show, Typeable)

205+ deriving (Show, Typeable, Eq)

202206

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

204208data EventErrorCode =

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

208212 | EventTransportFailed

209213 -- | Connection to a remote endpoint was lost

210214 | 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)

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

2020import Data.String (fromString)

2121import Data.Maybe (catMaybes)

22+import Data.List (permutations)

2223import Traced

2324

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

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

679680 Right conn <- connect endpoint theirAddr2 ReliableOrdered

680681 send conn ["pong"]

681682

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

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

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

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

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

684+ evs <- replicateM 3 $ receive endpoint

685+ let expected = [ ConnectionClosed cid1

686+ , ConnectionClosed cid2

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

688+ ]

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

686690

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

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