@@ -1,7 +1,7 @@
11import Test.Framework (defaultMain, testGroup)
22import Test.Framework.Providers.QuickCheck2 (testProperty)
33import Test.QuickCheck (Gen, choose, suchThatMaybe, forAll)
4−import Test.QuickCheck.Property (morallyDubiousIOProperty)
4+import Test.QuickCheck.Property (morallyDubiousIOProperty, Result(..), result)
55import Data.Map (Map)
66import qualified Data.Map as Map
77import Control.Applicative ((<$>))
@@ -49,7 +49,7 @@ connectCloseScript numEndPoints = go Map.empty
4949 return []
5050
5151 isOpen :: Map Int Bool -> Int -> Bool
52− isOpen conns connIdx = connIdx `Map.member` conns && conns Map.! connIdx
52+ isOpen conns connIx = connIx `Map.member` conns && conns Map.! connIx
5353
5454execScript :: Transport -> Int -> Script -> IO (Map Int [Event])
5555execScript transport numEndPoints script = do
@@ -63,12 +63,12 @@ execScript transport numEndPoints script = do
6363 runScript endPoints = go
6464 where
6565 go :: [Connection] -> Script -> IO ()
66− go _ [] = threadDelay 50000 >> mapM_ closeEndPoint endPoints
66+ go _ [] = threadDelay 500000 >> mapM_ closeEndPoint endPoints
6767 go conns cmd@(Connect fr to rel hints : cmds) = do
6868 Right conn <- connect (endPoints !! fr) (address (endPoints !! to)) rel hints
6969 go (conns ++ [conn]) cmds
70− go conns cmd@(Close connIdx : cmds) = do
71− close (conns !! connIdx)
70+ go conns cmd@(Close connIx : cmds) = do
71+ close (conns !! connIx)
7272 go conns cmds
7373
7474 forwardTo :: Chan (Int, Event) -> (Int, EndPoint) -> IO ()
@@ -81,7 +81,7 @@ execScript transport numEndPoints script = do
8181 case ev of
8282 EndPointClosed -> return ()
8383 _ -> go
84−
84+
8585 collectAll :: Chan (Int, Event) -> Int -> IO (Map Int [Event])
8686 collectAll chan = go (Map.fromList (zip [0 .. numEndPoints - 1] (repeat [])))
8787 where
@@ -95,11 +95,37 @@ execScript transport numEndPoints script = do
9595 _ -> numDone
9696 go acc' numDone'
9797
98+verify :: Int -> Script -> Map Int [Event] -> Result
99+verify numEndPoints script evs =
100+ case go script [] evs of
101+ Nothing -> result { ok = Just True
102+ }
103+ Just err -> result { ok = Just False
104+ , reason = err
105+ }
106+ where
107+ go :: Script -> [(Int, ConnectionId)] -> Map Int [Event] -> Maybe String
108+ go [] conns evs =
109+ let closed = Map.fromList (zip [0 .. numEndPoints - 1] (repeat [EndPointClosed])) in
110+ if evs == closed then Nothing
111+ else Just $ "Expected " ++ show closed ++ "; got " ++ show evs
112+ go (Connect fr to rel hints : cmds) conns evs =
113+ case evs Map.! to of
114+ (ConnectionOpened connId rel' addr : epEvs) | rel' == rel ->
115+ go cmds (conns ++ [(to, connId)]) (Map.insert to epEvs evs)
116+ _ -> Just $ "Missing ConnectionOpened event in " ++ show evs
117+ go (Close connIx : cmds) conns evs =
118+ let (epIx, connId) = conns !! connIx in
119+ case evs Map.! epIx of
120+ (ConnectionClosed connId' : epEvs) | connId' == connId ->
121+ go cmds conns (Map.insert epIx epEvs evs)
122+ _ -> Just $ "Missing ConnectionClosed event in " ++ show evs
123+
98124prop_connect_close transport = forAll (connectCloseScript 2) $ \script ->
99125 morallyDubiousIOProperty $ do
100126 logShow script
101127 evs <- execScript transport 2 script
102− return (evs == Map.fromList [])
128+ return (verify 2 script evs)
103129
104130tests transport = [
105131 testGroup "Unidirectional" [