Test that historic participants are counted

2 files changed, 52 insertions, 0 deletions

diff --git a/Test/Participants.hs b/Test/Participants.hs
new file mode 100644
index 0000000..f65fa15
--- /dev/null
+++ b/Test/Participants.hs
@@ -0,0 +1,38 @@
+-- Tests that services visible in a log are listed as participants even if they
+-- disconnect from the bus before the end of the log. This is a regression test
+-- for a bug I almost introduced.
+module Main where
+
+import Control.Monad (when)
+import qualified Data.Set as Set
+import System.Exit (exitFailure)
+
+import Bustle.Types
+import Bustle.Renderer
+
+activeService = UniqueName ":1.1"
+swaddle = map (\m -> DetailedMessage 0 m Nothing)
+sessionLog =
+    [ Connected activeService
+    , Signal (U activeService) Nothing $ Member "/" Nothing "Hello"
+    ]
+sessionLogWithDisconnect = sessionLog ++ [ Disconnected activeService ]
+expectedParticipants = [ (activeService, Set.empty) ]
+
+assertEquals expected actual =
+    when (expected /= actual) $ do
+        putStrLn "Expected:"
+        print expected
+        putStrLn "Got:"
+        print actual
+        exitFailure
+
+test l expected = do
+    let rr = process (swaddle l) []
+        ps = sessionParticipants (rrApplications rr)
+
+    assertEquals expected ps
+
+main = do
+    test sessionLog expectedParticipants
+    test sessionLogWithDisconnect expectedParticipants
diff --git a/bustle.cabal b/bustle.cabal
index 5be710a..b7b9070 100644
--- a/bustle.cabal
+++ b/bustle.cabal
@@ -149,3 +149,17 @@ Test-suite test-regions
     other-modules: Bustle.Regions
     Build-Depends: base
                  , QuickCheck
+
+Test-suite test-participants
+    type: exitcode-stdio-1.0
+    main-is: Test/Participants.hs
+    other-modules: Bustle.Renderer
+    Build-Depends: base
+                 , cairo
+                 , containers
+                 , dbus-core
+                 , directory
+                 , filepath
+                 , gtk
+                 , mtl
+                 , pango