@@ -161,8 +161,8 @@ verify (transport, transportInternals) script = do
161161 case mEndPoint of
162162 Right endPoint -> do
163163 tid <- liftIO $ forkIO (forward endPoint)
164− modify endPoints (snoc endPoint)
165− modify forwardingThreads (tid :)
164+ append endPoints endPoint
165+ append forwardingThreads tid
166166 set (expectedEventsAt (address endPoint)) []
167167 Left err ->
168168 liftIO $ throwIO err
@@ -184,8 +184,8 @@ verify (transport, transportInternals) script = do
184184 , connectionId = connId
185185 , connectionBundle = currentBundleId
186186 }
187− modify connections (snoc (conn, connInfo))
188− modify (expectedEventsAt endPointB) (snoc (ExpConnectionOpened connInfo))
187+ append connections (conn, connInfo)
188+ append (expectedEventsAt endPointB) (ExpConnectionOpened connInfo)
189189 Left err -> do
190190 currentBundleId <- get bundleId
191191 expectingBreak <- get $ mayBreak currentBundleId
@@ -198,7 +198,7 @@ verify (transport, transportInternals) script = do
198198 runCmd (Close i) = do
199199 (conn, connInfo) <- get (connectionAt i)
200200 liftIO $ close conn
201− modify (expectedEventsAt (target connInfo)) (snoc (ExpConnectionClosed connInfo))
201+ append (expectedEventsAt (target connInfo)) (ExpConnectionClosed connInfo)
202202 runCmd (Send i payload) = do
203203 (conn, connInfo) <- get (connectionAt i)
204204 mResult <- liftIO $ send conn payload
@@ -213,7 +213,7 @@ verify (transport, transportInternals) script = do
213213 set (broken (connectionBundle connInfo)) True
214214 else
215215 liftIO $ throwIO err
216− modify (expectedEventsAt (target connInfo)) (snoc (ExpReceived connInfo payload))
216+ append (expectedEventsAt (target connInfo)) (ExpReceived connInfo payload)
217217 runCmd (BreakAfterReads n i j) = do
218218 endPointA <- address <$> get (endPointAtIx i)
219219 endPointB <- address <$> get (endPointAtIx j)
@@ -222,8 +222,8 @@ verify (transport, transportInternals) script = do
222222 scheduleReadAction sock n (sClose sock)
223223 currentBundleId <- get (currentBundle endPointA endPointB)
224224 set (mayBreak currentBundleId) True
225− modify (expectedEventsAt endPointA) (snoc (ExpConnectionLost currentBundleId endPointB))
226− modify (expectedEventsAt endPointB) (snoc (ExpConnectionLost currentBundleId endPointA))
225+ append (expectedEventsAt endPointA) (ExpConnectionLost currentBundleId endPointB)
226+ append (expectedEventsAt endPointB) (ExpConnectionLost currentBundleId endPointA)
227227
228228 forward :: EndPoint -> IO ()
229229 forward endPoint = forever $ do
@@ -586,6 +586,16 @@ script_BreakSendReconnect = [
586586 , Send 1 ["ping2"]
587587 ]
588588
589+script_Foo :: Script
590+script_Foo = [
591+ NewEndPoint
592+ , NewEndPoint
593+ , Connect 1 0
594+ , BreakAfterReads 2 0 1
595+ , Send 0 ["pingpong"]
596+ , Connect 0 1
597+ ]
598+
589599--------------------------------------------------------------------------------
590600-- Main application driver --
591601--------------------------------------------------------------------------------
@@ -609,6 +619,7 @@ tests transport = [
609619 , testOne "BreakConnect1" transport script_BreakConnect1
610620 , testOne "BreakConnect2" transport script_BreakConnect2
611621 , testOne "BreakSendReconnect" transport script_BreakSendReconnect
622+ , testOne "Foo" transport script_Foo
612623 ]
613624 , testGroup "Without errors" [
614625 testGroup "One endpoint, with delays" (basicTests transport 1 id)
@@ -787,6 +798,9 @@ instance Arbitrary ByteString where
787798listAccessor :: Int -> Accessor [a] a
788799listAccessor i = accessor (!! i) (error "listAccessor.set not defined")
789800
801+append :: Monad m => Accessor st [a] -> a -> StateT st m ()
802+append acc x = modify acc (snoc x)
803+
790804snoc :: a -> [a] -> [a]
791805snoc x xs = xs ++ [x]
792806