git.iko.soy/typeable/postgresql-simple
on master help sign in
test: Add Notify
385ce1aJoey Adams
postgresql-simple.cabal+1
compare with master
unifiedsplit
@@ -71,6 +71,7 @@ test-suite test
71 main-is: Main.hs
71 main-is: Main.hs
72 other-modules:
72 other-modules:
73 Bytea
73 Bytea
74+ Notify
74
75
75 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
76 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
76
77
test/Main.hs+16−4
@@ -9,15 +9,27 @@ import System.IO
9import Test.HUnit
9import Test.HUnit
10
10
11import Bytea
11import Bytea
12+import Notify
13+
14+-- | Action for connecting to the database that will be used for testing.
15+--
16+-- Note that some tests, such as Notify, use multiple connections, and assume
17+-- that 'testConnect' connects to the same database every time it is called.
18+testConnect :: IO Connection
19+testConnect = connectPostgreSQL ""
20+
21+withConn :: (Connection -> IO a) -> IO a
22+withConn = bracket testConnect close
12
23
13tests :: Connection -> [Test]
24tests :: Connection -> [Test]
14tests conn =
25tests conn =
15− [ TestLabel "Bytea" $ testBytea conn
26+ [ TestLabel "Bytea" $ testBytea conn
27+ , TestLabel "Notify" $ testNotify conn withConn
16 ]
28 ]
17
29
18main :: IO ()
30main :: IO ()
19main = do
31main = do
20 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
32 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
21− bracket (connectPostgreSQL "") close $ \conn -> do
22− Counts{cases, tried, errors, failures} <- runTestTT $ TestList $ tests conn
33+ Counts{cases, tried, errors, failures} <-
34+ withConn $ runTestTT . TestList . tests
23− when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
35+ when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
test/Notify.hsnew file+43
@@ -0,0 +1,43 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Notify (testNotify) where
3+
4+import Control.Applicative
5+import Control.Concurrent
6+import Control.Monad
7+import Data.Function
8+import Data.List
9+import Database.PostgreSQL.Simple
10+import Database.PostgreSQL.Simple.Notification
11+import Test.HUnit
12+
13+import qualified Data.ByteString as B
14+
15+-- TODO: Test with payload, but only for PostgreSQL >= 9.0
16+-- (when that feature was introduced).
17+
18+testNotify :: Connection -> ((Connection -> IO ()) -> IO ()) -> Test
19+testNotify conn withConn =
20+ TestCase $
21+ withConn $ \conn2 -> do
22+ execute_ conn "LISTEN foo"
23+ execute_ conn "LISTEN bar"
24+
25+ results_mv <- newEmptyMVar
26+ forkIO $ replicateM 2 (getNotification conn)
27+ >>= putMVar results_mv
28+
29+ threadDelay 100000
30+
31+ execute_ conn2 "NOTIFY foo"
32+ execute_ conn2 "NOTIFY bar"
33+
34+ [n1, n2] <- sortBy (compare `on` notificationChannel)
35+ <$> takeMVar results_mv
36+
37+ assertEqual "n1" "bar" (notificationChannel n1)
38+ assertEqual "n2" "foo" (notificationChannel n2)
39+
40+ -- Other sanity checks
41+ assertEqual "Server PIDs match" (notificationPid n1) (notificationPid n2)
42+ assertBool "notificationData is empty" $
43+ all (B.null . notificationData) [n1, n2]