2c44712 · distributed-process

1import Test.Framework (defaultMain, testGroup)

2import Test.Framework.Providers.QuickCheck2 (testProperty)

3import Test.QuickCheck (Gen, choose, suchThatMaybe, forAll)

4−import Test.QuickCheck.Property (morallyDubiousIOProperty)

4+import Test.QuickCheck.Property (morallyDubiousIOProperty, Result(..), result)

5import Data.Map (Map)

6import qualified Data.Map as Map

7import Control.Applicative ((<$>))

49 return []

50

51 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

53

54execScript :: Transport -> Int -> Script -> IO (Map Int [Event])

55execScript transport numEndPoints script = do

63 runScript endPoints = go

64 where

65 go :: [Connection] -> Script -> IO ()

66− go _ [] = threadDelay 50000 >> mapM_ closeEndPoint endPoints

66+ go _ [] = threadDelay 500000 >> mapM_ closeEndPoint endPoints

67 go conns cmd@(Connect fr to rel hints : cmds) = do

68 Right conn <- connect (endPoints !! fr) (address (endPoints !! to)) rel hints

69 go (conns ++ [conn]) cmds

70− go conns cmd@(Close connIdx : cmds) = do

70+ go conns cmd@(Close connIx : cmds) = do

71− close (conns !! connIdx)

71+ close (conns !! connIx)

72 go conns cmds

73

74 forwardTo :: Chan (Int, Event) -> (Int, EndPoint) -> IO ()

81 case ev of

82 EndPointClosed -> return ()

83 _ -> go

84−

84+

85 collectAll :: Chan (Int, Event) -> Int -> IO (Map Int [Event])

86 collectAll chan = go (Map.fromList (zip [0 .. numEndPoints - 1] (repeat [])))

87 where

95 _ -> numDone

96 go acc' numDone'

97

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+

98prop_connect_close transport = forAll (connectCloseScript 2) $ \script ->

124prop_connect_close transport = forAll (connectCloseScript 2) $ \script ->

99 morallyDubiousIOProperty $ do

125 morallyDubiousIOProperty $ do

100 logShow script

126 logShow script

101 evs <- execScript transport 2 script

127 evs <- execScript transport 2 script

102− return (evs == Map.fromList [])

128+ return (verify 2 script evs)

103

129

104tests transport = [

130tests transport = [

105 testGroup "Unidirectional" [

131 testGroup "Unidirectional" [