git.iko.soy/typeable/postgresql-simple
on 592fe13 help sign in
typeable/postgresql-simple/test/Main.hs
102 lines 3.3 kB history raw
1import Common
2import Control.Exception as E
3import Control.Monad
4import Data.ByteString (ByteString)
5import qualified Data.ByteString as B
6import System.Exit (exitFailure)
7import System.IO
9import Notify
10import Serializable
11import Time
13tests :: [TestEnv -> Test]
14tests =
15 [ TestLabel "Bytea" . testBytea
16 , TestLabel "ExecuteMany" . testExecuteMany
17 , TestLabel "Fold" . testFold
18 , TestLabel "Notify" . testNotify
19 , TestLabel "Serializable" . testSerializable
20 , TestLabel "Time" . testTime
21 ]
23testBytea :: TestEnv -> Test
24testBytea TestEnv{..} = TestList
25 [ testStr "empty" []
26 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)
27 , testStr "ascending" [0..255]
28 , testStr "descending" [255,254..0]
29 , testStr "ascending, doubled up" $ doubleUp [0..255]
30 , testStr "descending, doubled up" $ doubleUp [255,254..0]
31 ]
32 where
33 testStr label bytes = TestLabel label $ TestCase $ do
34 let bs = B.pack bytes
36 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]
37 assertBool "Haskell -> SQL conversion altered the string" $ md5 bs == h
39 [Only (Binary r)] <- query conn "SELECT ?::bytea" [Binary bs]
40 assertBool "SQL -> Haskell conversion altered the string" $ bs == r
42 doubleUp = concatMap (\x -> [x, x])
44testExecuteMany :: TestEnv -> Test
45testExecuteMany TestEnv{..} = TestCase $ do
46 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"
48 let rows :: [(Int, String, Binary ByteString)]
49 rows = [ (1, "hello", Binary "bye")
50 , (2, "world", Binary "\0\r\t\n")
51 , (3, "?", Binary "")
52 ]
54 count <- executeMany conn "INSERT INTO tmp_executeMany VALUES (?, ?, ?)" rows
55 count @?= fromIntegral (length rows)
57 rows' <- query_ conn "SELECT * FROM tmp_executeMany"
58 rows' @?= rows
60 return ()
62testFold :: TestEnv -> Test
63testFold TestEnv{..} = TestCase $ do
64 xs <- fold_ conn "SELECT generate_series(1,10000)"
65 [] $ \xs (Only x) -> return (x:xs)
66 reverse xs @?= ([1..10000] :: [Int])
68 -- TODO: add more complete tests, e.g.:
69 --
70 -- * Fold in a transaction
71 --
72 -- * Fold in a transaction after a previous fold has been performed
73 --
74 -- * Nested fold
76 return ()
78------------------------------------------------------------------------
80-- | Action for connecting to the database that will be used for testing.
81--
82-- Note that some tests, such as Notify, use multiple connections, and assume
83-- that 'testConnect' connects to the same database every time it is called.
84testConnect :: IO Connection
85testConnect = connectPostgreSQL ""
87withTestEnv :: (TestEnv -> IO a) -> IO a
88withTestEnv cb =
89 withConn $ \conn ->
90 cb TestEnv
91 { conn = conn
92 , withConn = withConn
93 }
94 where
95 withConn = bracket testConnect close
97main :: IO ()
98main = do
99 mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
100 Counts{cases, tried, errors, failures} <-
101 withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests
102 when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure