87ba6a3 · typeable/postgresql-simple

test/Bytea.hs+3−2

compare with master

unifiedsplit

@@ -1,11 +1,12 @@

1{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecordWildCards #-}

2module Bytea (testBytea) where

3module Bytea (testBytea) where

3

4

4import Common

5import Common

5import qualified Data.ByteString as B

6import qualified Data.ByteString as B

6

7

7−testBytea :: Connection -> Test

8+testBytea :: TestEnv -> Test

8−testBytea conn = TestList

9+testBytea TestEnv{..} = TestList

9 [ testStr "empty" []

10 [ testStr "empty" []

10 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

11 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

11 , testStr "ascending" [0..255]

12 , testStr "ascending" [0..255]

test/Common.hs+10

@@ -1,6 +1,8 @@

1+{-# LANGUAGE Rank2Types #-}

1module Common (

2module Common (

2 module Database.PostgreSQL.Simple,

3 module Database.PostgreSQL.Simple,

3 module Test.HUnit,

4 module Test.HUnit,

5+ TestEnv(..),

4 md5,

6 md5,

5) where

7) where

6

8

@@ -13,6 +15,14 @@ import qualified Crypto.Hash.MD5 as MD5

13import qualified Data.ByteString.Base16 as Base16

15import qualified Data.ByteString.Base16 as Base16

14import qualified Data.Text.Encoding as TE

16import qualified Data.Text.Encoding as TE

15

17

18+data TestEnv

19+ = TestEnv

20+ { conn :: Connection

21+ -- ^ Connection shared by all the tests

22+ , withConn :: forall a. (Connection -> IO a) -> IO a

23+ -- ^ Bracket for spawning additional connections

24+ }

25+

16-- | Return the MD5 hash of a 'ByteString', in lowercase hex format.

26-- | Return the MD5 hash of a 'ByteString', in lowercase hex format.

17--

27--

18-- Example:

28-- Example:

test/Main.hs+18−12

@@ -1,15 +1,14 @@

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE NamedFieldPuns #-}

3

4+import Common

5+import Bytea

6+import Notify

7+

4import Control.Exception (bracket)

8import Control.Exception (bracket)

5import Control.Monad (when)

9import Control.Monad (when)

6−import Database.PostgreSQL.Simple

7import System.Exit (exitFailure)

10import System.Exit (exitFailure)

8import System.IO

11import System.IO

9−import Test.HUnit

10−

11−import Bytea

12−import Notify

13

12

14-- | Action for connecting to the database that will be used for testing.

13-- | Action for connecting to the database that will be used for testing.

15--

14--

@@ -18,18 +17,25 @@ import Notify

18testConnect :: IO Connection

17testConnect :: IO Connection

19testConnect = connectPostgreSQL ""

18testConnect = connectPostgreSQL ""

20

19

21−withConn :: (Connection -> IO a) -> IO a

20+withTestEnv :: (TestEnv -> IO a) -> IO a

21+withTestEnv cb =

22+ withConn $ \conn ->

23+ cb TestEnv

24+ { conn = conn

25+ , withConn = withConn

26+ }

27+ where

22−withConn = bracket testConnect close

28+ withConn = bracket testConnect close

23

29

24−tests :: Connection -> [Test]

30+tests :: [TestEnv -> Test]

25−tests conn =

31+tests =

26− [ TestLabel "Bytea" $ testBytea conn

32+ [ TestLabel "Bytea" . testBytea

27− , TestLabel "Notify" $ testNotify conn withConn

33+ , TestLabel "Notify" . testNotify

28 ]

34 ]

29

35

30main :: IO ()

36main :: IO ()

31main = do

37main = do

32 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]

38 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]

33 Counts{cases, tried, errors, failures} <-

39 Counts{cases, tried, errors, failures} <-

34− withConn $ runTestTT . TestList . tests

40+ withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests

35 when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure

41 when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure

test/Notify.hs+3−2

@@ -1,4 +1,5 @@

1{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecordWildCards #-}

2module Notify (testNotify) where

3module Notify (testNotify) where

3

4

4import Common

5import Common

@@ -15,8 +16,8 @@ import qualified Data.ByteString as B

15-- TODO: Test with payload, but only for PostgreSQL >= 9.0

16-- TODO: Test with payload, but only for PostgreSQL >= 9.0

16-- (when that feature was introduced).

17-- (when that feature was introduced).

17

18

18−testNotify :: Connection -> ((Connection -> IO ()) -> IO ()) -> Test

19+testNotify :: TestEnv -> Test

19−testNotify conn withConn =

20+testNotify TestEnv{..} =

20 TestCase $

21 TestCase $

21 withConn $ \conn2 -> do

22 withConn $ \conn2 -> do

22 execute_ conn "LISTEN foo"

23 execute_ conn "LISTEN foo"