@@ -157,8 +157,49 @@ script_ConnectClose numEndPoints = do
157-- Individual scripts to test specific bugs --
157-- Individual scripts to test specific bugs --
158--------------------------------------------------------------------------------
158--------------------------------------------------------------------------------
160−testScript1 :: Script
160+-- | Bug #1
161−testScript1 = [
161+--
162+-- When process A wants to close the heavyweight connection to process B it
163+-- sends a CloseSocket request together with the ID of the last connection from
164+-- B. When B receives the CloseSocket request it can compare this ID to the last
165+-- connection it created; if they don't match, B knows that there are some
166+-- messages still on the way from B to A (in particular, a CreatedConnection
167+-- message) which will cancel the CloseSocket request from A. Hence, it will
168+-- know to ignore the CloseSocket request from A.
170+-- The bug was that we recorded the last _created_ outgoing connection on the
171+-- local endpoint, but the last _received_ incoming connection on the state of
172+-- the heavyweight connection. So, in the script below, the following happened:
174+-- A connects to B, records "last connection ID is 1024"
175+-- A closes the lightweight connection, sends [CloseConnection 1024]
176+-- A closes the heivyweight connection, sends [CloseSocket 0]
178+-- (the 0 here indicates that it had not yet received any connections from B)
180+-- B receives the [CloseSocket 0], compares it to the recorded outgoing ID (0),
181+-- confirms that they are equal, and confirms the CloseSocket request.
183+-- B connects to A, records "last connection ID is 1024"
184+-- B closes the lightweight connection, sends [CloseConnection 1024]
185+-- B closes the heavyweight connection, sends [CloseSocket 0]
187+-- (the 0 here indicates that it has not yet received any connections from A,
188+-- ON THIS HEAVYWEIGHT connection)
190+-- A receives the [CloseSocket 0] request, compares it to the last recorded
191+-- outgoing ID (1024), sees that they are not equal, and concludes that this
192+-- must mean that there is still a CreatedConnection message on the way from A
195+-- This of course is not the case, so B will wait forever for A to confirm
196+-- the CloseSocket request, and deadlock arises. (This deadlock doesn't become
197+-- obvious though until the next attempt from B to connect to A.)
199+-- The solution is of course that both the recorded outgoing and recorded
200+-- incoming connection ID must be per heavyweight connection.
201+script_Bug1 :: Script
162 NewEndPoint
203 NewEndPoint
163 , NewEndPoint
204 , NewEndPoint
164 , Connect 0 1
205 , Connect 0 1
@@ -174,13 +215,18 @@ testScript1 = [
175tests :: Transport -> [Test]
216tests :: Transport -> [Test]
176tests transport = [
217tests transport = [
219+ testOne "Bug1" script_Bug1
177− testGroup "Unidirectional" [
221+ , testGroup "Unidirectional" [
178− -- testProperty "NewEndPoint" (genericProp transport (script_NewEndPoint 2))
222+ testQC "NewEndPoint" (script_NewEndPoint 2)
179− --, testProperty "Connect" (genericProp transport (script_Connect 2))
223+ , testQC "Connect" (script_Connect 2)
180− testCase "testScript1" (testOneScript transport testScript1)
181− -- testProperty "ConnectClose" (genericProp transport (script_ConnectClose 2))
224+ , testQC "ConnectClose" (script_ConnectClose 2)
228+ testOne label script = testCase label (testScript transport script)
229+ testQC label script = testProperty label (testScriptGen transport script)
185main :: IO ()
231main :: IO ()
@@ -191,8 +237,8 @@ main = do
191-- Test infrastructure --
237-- Test infrastructure --
192--------------------------------------------------------------------------------
238--------------------------------------------------------------------------------
194−genericProp :: Transport -> Gen Script -> Property
240+testScriptGen :: Transport -> Gen Script -> Property
195−genericProp transport scriptGen =
241+testScriptGen transport scriptGen =
196 forAll scriptGen $ \script ->
242 forAll scriptGen $ \script ->
197 morallyDubiousIOProperty $ do
243 morallyDubiousIOProperty $ do
198 logShow script
244 logShow script
@@ -204,8 +250,8 @@ genericProp transport scriptGen =
204 , reason = '\n' : err ++ "\nAll events: " ++ show evs
250 , reason = '\n' : err ++ "\nAll events: " ++ show evs
207−testOneScript :: Transport -> Script -> Assertion
253+testScript :: Transport -> Script -> Assertion
208−testOneScript transport script = do
254+testScript transport script = do
209 logShow script
255 logShow script
210 evs <- execScript transport script
256 evs <- execScript transport script
211 case verify script evs of
257 case verify script evs of