git.iko.soy/typeable/postgresql-simple
on master help sign in
Merge pull request #18 from joeyadams/test-notification

Add test for LISTEN/NOTIFY

commit926882700c8a9c8f9a702e61e8625ad4943e2b95 authorLeon P Smith <leon.p.smith+github@gmail.com> dateFri 18 May 2012, 06:23 (14 years ago) parent9762dd88c153c4
6 files changed+135−29
compare with master
unifiedsplit
postgresql-simple.cabal+9 test/Bytea.hs+5−16 test/Common.hs+32 test/Main.hs+26−11 test/Notify.hs+42 test/WRITING-TESTS+21−2
postgresql-simple.cabal+9
@@ -70,7 +70,16 @@ test-suite test
7070 hs-source-dirs: test
7171 main-is: Main.hs
7272 other-modules:
73+ Common
7374 Bytea
75+ Notify
76+
77+ ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
78+
79+ extensions: NamedFieldPuns
80+ , OverloadedStrings
81+ , Rank2Types
82+ , RecordWildCards
7483
7584 build-depends: base
7685 , base16-bytestring
test/Bytea.hs+5−16
@@ -1,18 +1,10 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Bytea where
1+module Bytea (testBytea) where
32
4−import Data.ByteString (ByteString)
5−import Data.Text (Text)
6−import Database.PostgreSQL.Simple
7−import Test.HUnit
3+import Common
4+import qualified Data.ByteString as B
85
9−import qualified Crypto.Hash.MD5 as MD5
10−import qualified Data.ByteString as B
11−import qualified Data.ByteString.Base16 as Base16
12−import qualified Data.Text.Encoding as TE
13−
14−testBytea :: Connection -> Test
15−testBytea conn = TestList
6+testBytea :: TestEnv -> Test
7+testBytea TestEnv{..} = TestList
168 [ testStr "empty" []
179 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)
1810 , testStr "ascending" [0..255]
@@ -31,6 +23,3 @@ testBytea conn = TestList
3123 assertBool "SQL -> Haskell conversion altered the string" $ bs == r
3224
3325 doubleUp = concatMap (\x -> [x, x])
34−
35−md5 :: ByteString -> Text
36−md5 = TE.decodeUtf8 . Base16.encode . MD5.hash
test/Common.hsnew file+32
@@ -0,0 +1,32 @@
1+module Common (
2+ module Database.PostgreSQL.Simple,
3+ module Test.HUnit,
4+ TestEnv(..),
5+ md5,
6+) where
7+
8+import Data.ByteString (ByteString)
9+import Data.Text (Text)
10+import Database.PostgreSQL.Simple
11+import Test.HUnit
12+
13+import qualified Crypto.Hash.MD5 as MD5
14+import qualified Data.ByteString.Base16 as Base16
15+import qualified Data.Text.Encoding as TE
16+
17+data TestEnv
18+ = TestEnv
19+ { conn :: Connection
20+ -- ^ Connection shared by all the tests
21+ , withConn :: forall a. (Connection -> IO a) -> IO a
22+ -- ^ Bracket for spawning additional connections
23+ }
24+
25+-- | Return the MD5 hash of a 'ByteString', in lowercase hex format.
26+--
27+-- Example:
28+--
29+-- >[Only hash] <- query_ conn "SELECT md5('hi')"
30+-- >assertEqual "md5('hi')" (md5 "hi") hash
31+md5 :: ByteString -> Text
32+md5 = TE.decodeUtf8 . Base16.encode . MD5.hash
test/Main.hs+26−11
@@ -1,23 +1,38 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE NamedFieldPuns #-}
3−
1+import Common
42import Control.Exception (bracket)
53import Control.Monad (when)
6−import Database.PostgreSQL.Simple
74import System.Exit (exitFailure)
85import System.IO
9−import Test.HUnit
106
117import Bytea
8+import Notify
129
13−tests :: Connection -> [Test]
14−tests conn =
15− [ TestLabel "Bytea" $ testBytea conn
10+tests :: [TestEnv -> Test]
11+tests =
12+ [ TestLabel "Bytea" . testBytea
13+ , TestLabel "Notify" . testNotify
1614 ]
1715
16+-- | Action for connecting to the database that will be used for testing.
17+--
18+-- Note that some tests, such as Notify, use multiple connections, and assume
19+-- that 'testConnect' connects to the same database every time it is called.
20+testConnect :: IO Connection
21+testConnect = connectPostgreSQL ""
22+
23+withTestEnv :: (TestEnv -> IO a) -> IO a
24+withTestEnv cb =
25+ withConn $ \conn ->
26+ cb TestEnv
27+ { conn = conn
28+ , withConn = withConn
29+ }
30+ where
31+ withConn = bracket testConnect close
32+
1833main :: IO ()
1934main = do
2035 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
21− bracket (connectPostgreSQL "") close $ \conn -> do
22− Counts{cases, tried, errors, failures} <- runTestTT $ TestList $ tests conn
23− when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
36+ Counts{cases, tried, errors, failures} <-
37+ withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests
38+ when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
test/Notify.hsnew file+42
@@ -0,0 +1,42 @@
1+module Notify (testNotify) where
2+
3+import Common
4+
5+import Control.Applicative
6+import Control.Concurrent
7+import Control.Monad
8+import Data.Function
9+import Data.List
10+import Database.PostgreSQL.Simple.Notification
11+
12+import qualified Data.ByteString as B
13+
14+-- TODO: Test with payload, but only for PostgreSQL >= 9.0
15+-- (when that feature was introduced).
16+
17+testNotify :: TestEnv -> Test
18+testNotify TestEnv{..} =
19+ TestCase $
20+ withConn $ \conn2 -> do
21+ execute_ conn "LISTEN foo"
22+ execute_ conn "LISTEN bar"
23+
24+ results_mv <- newEmptyMVar
25+ forkIO $ replicateM 2 (getNotification conn)
26+ >>= putMVar results_mv
27+
28+ threadDelay 100000
29+
30+ execute_ conn2 "NOTIFY foo"
31+ execute_ conn2 "NOTIFY bar"
32+
33+ [n1, n2] <- sortBy (compare `on` notificationChannel)
34+ <$> takeMVar results_mv
35+
36+ assertEqual "n1" "bar" (notificationChannel n1)
37+ assertEqual "n2" "foo" (notificationChannel n2)
38+
39+ -- Other sanity checks
40+ assertEqual "Server PIDs match" (notificationPid n1) (notificationPid n2)
41+ assertBool "notificationData is empty" $
42+ all (B.null . notificationData) [n1, n2]
test/WRITING-TESTS+21−2
@@ -3,9 +3,28 @@ starts the HUnit text-based test controller.
33
44To add a new module to the test suite, do the following:
55
6− * Create a new module that exports a function of type Connection -> Test.
6+ * Create a new module that exports a function of type TestEnv -> Test.
7+ For example:
8+
9+ module Foo (testFoo) where
10+
11+ import Common
12+
13+ testFoo :: TestEnv -> Test
14+ testFoo TestEnv{..} = ...
15+
16+ 'TestEnv' (defined in Common.hs) contains information for accessing the
17+ database. `TestEnv{..}` is a record wildcard which brings the following
18+ definitions into scope:
19+
20+ conn :: Connection
21+ withConn :: (Connection -> IO a) -> IO a
22+
23+ 'conn' is a database connection shared by all the tests.
24+ 'withConn' can be used to open additional connections (to the same database).
25+
726 'Test' is basically a tree of 'Assertion's, where 'Assertion' is just a type
8− alias for IO (). See Bytea.hs for reference.
27+ alias for IO (). See the HLint documentation for more information.
928
1029 * Add an entry to 'tests' in Main.hs (along with the corresponding
1130 module import) so the test driver will know about the new module.