git.iko.soy/typeable/postgresql-simple
on master help sign in
Merge pull request #18 from joeyadams/test-notification
9268827Leon P Smith
postgresql-simple.cabal+9
compare with master
unifiedsplit
@@ -70,7 +70,16 @@ test-suite test
70 hs-source-dirs: test
70 hs-source-dirs: test
71 main-is: Main.hs
71 main-is: Main.hs
72 other-modules:
72 other-modules:
73+ Common
73 Bytea
74 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
74
83
75 build-depends: base
84 build-depends: base
76 , base16-bytestring
85 , base16-bytestring
test/Bytea.hs+5−16
@@ -1,18 +1,10 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Bytea where
1+module Bytea (testBytea) where
3
2
4−import Data.ByteString (ByteString)
3+import Common
5−import Data.Text (Text)
4+import qualified Data.ByteString as B
6−import Database.PostgreSQL.Simple
7−import Test.HUnit
8
5
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
6+testBytea :: TestEnv -> Test
15−testBytea conn = TestList
7+testBytea TestEnv{..} = TestList
16 [ testStr "empty" []
8 [ testStr "empty" []
17 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)
9 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)
18 , testStr "ascending" [0..255]
10 , testStr "ascending" [0..255]
@@ -31,6 +23,3 @@ testBytea conn = TestList
31 assertBool "SQL -> Haskell conversion altered the string" $ bs == r
23 assertBool "SQL -> Haskell conversion altered the string" $ bs == r
32
24
33 doubleUp = concatMap (\x -> [x, x])
25 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 #-}
1+import Common
2−{-# LANGUAGE NamedFieldPuns #-}
3−
4import Control.Exception (bracket)
2import Control.Exception (bracket)
5import Control.Monad (when)
3import Control.Monad (when)
6−import Database.PostgreSQL.Simple
7import System.Exit (exitFailure)
4import System.Exit (exitFailure)
8import System.IO
5import System.IO
9−import Test.HUnit
10
6
11import Bytea
7import Bytea
8+import Notify
12
9
13−tests :: Connection -> [Test]
10+tests :: [TestEnv -> Test]
14−tests conn =
11+tests =
15− [ TestLabel "Bytea" $ testBytea conn
12+ [ TestLabel "Bytea" . testBytea
13+ , TestLabel "Notify" . testNotify
16 ]
14 ]
17
15
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+
18main :: IO ()
33main :: IO ()
19main = do
34main = do
20 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
35 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
21− bracket (connectPostgreSQL "") close $ \conn -> do
22− Counts{cases, tried, errors, failures} <- runTestTT $ TestList $ tests conn
36+ Counts{cases, tried, errors, failures} <-
37+ withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests
23− when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
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.
3
3
4To add a new module to the test suite, do the following:
4To add a new module to the test suite, do the following:
5
5
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+
7 'Test' is basically a tree of 'Assertion's, where 'Assertion' is just a type
26 '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.
9
28
10 * Add an entry to 'tests' in Main.hs (along with the corresponding
29 * Add an entry to 'tests' in Main.hs (along with the corresponding
11 module import) so the test driver will know about the new module.
30 module import) so the test driver will know about the new module.