git.iko.soy/typeable/postgresql-simple
on master help sign in
Make it easier to add new tests
84c189aJoey Adams
postgresql-simple.cabal+1−3
compare with master
unifiedsplit
@@ -78,9 +78,6 @@ test-suite test
78 main-is: Main.hs
78 main-is: Main.hs
79 other-modules:
79 other-modules:
80 Common
80 Common
81− Bytea
82− ExecuteMany
83− Fold
84 Notify
81 Notify
85 Serializable
82 Serializable
86 Time
83 Time
@@ -92,6 +89,7 @@ test-suite test
92 , Rank2Types
89 , Rank2Types
93 , RecordWildCards
90 , RecordWildCards
94 , PatternGuards
91 , PatternGuards
92+ , ScopedTypeVariables
95
93
96 build-depends: base
94 build-depends: base
97 , base16-bytestring
95 , base16-bytestring
test/Bytea.hsdeleted−25
@@ -1,25 +0,0 @@
1−module Bytea (testBytea) where
2−
3−import Common
4−import qualified Data.ByteString as B
5−
6−testBytea :: TestEnv -> Test
7−testBytea TestEnv{..} = TestList
8− [ testStr "empty" []
9− , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)
10− , testStr "ascending" [0..255]
11− , testStr "descending" [255,254..0]
12− , testStr "ascending, doubled up" $ doubleUp [0..255]
13− , testStr "descending, doubled up" $ doubleUp [255,254..0]
14− ]
15− where
16− testStr label bytes = TestLabel label $ TestCase $ do
17− let bs = B.pack bytes
18−
19− [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]
20− assertBool "Haskell -> SQL conversion altered the string" $ md5 bs == h
21−
22− [Only (Binary r)] <- query conn "SELECT ?::bytea" [Binary bs]
23− assertBool "SQL -> Haskell conversion altered the string" $ bs == r
24−
25− doubleUp = concatMap (\x -> [x, x])
test/ExecuteMany.hsdeleted−23
@@ -1,23 +0,0 @@
1−module ExecuteMany (testExecuteMany) where
2−
3−import Common
4−
5−import Data.ByteString (ByteString)
6−
7−testExecuteMany :: TestEnv -> Test
8−testExecuteMany TestEnv{..} = TestCase $ do
9− execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"
10−
11− let rows :: [(Int, String, Binary ByteString)]
12− rows = [ (1, "hello", Binary "bye")
13− , (2, "world", Binary "\0\r\t\n")
14− , (3, "?", Binary "")
15− ]
16−
17− count <- executeMany conn "INSERT INTO tmp_executeMany VALUES (?, ?, ?)" rows
18− assertEqual "count" (fromIntegral $ length rows) count
19−
20− rows' <- query_ conn "SELECT * FROM tmp_executeMany"
21− assertEqual "rows" rows rows'
22−
23− return ()
test/Fold.hsdeleted−19
@@ -1,19 +0,0 @@
1−module Fold (testFold) where
2−
3−import Common
4−
5−testFold :: TestEnv -> Test
6−testFold TestEnv{..} = TestCase $ do
7− xs <- fold_ conn "SELECT generate_series(1,10000)"
8− [] $ \xs (Only x) -> return (x:xs)
9− True <- return $ reverse xs == ([1..10000] :: [Int])
10−
11− -- TODO: add more complete tests, e.g.:
12− --
13− -- * Fold in a transaction
14− --
15− -- * Fold in a transaction after a previous fold has been performed
16− --
17− -- * Nested fold
18−
19− return ()
test/Main.hs+64−8
@@ -1,12 +1,11 @@
1import Common
1import Common
2−import Control.Exception (bracket)
2+import Control.Exception as E
3−import Control.Monad (when)
3+import Control.Monad
4+import Data.ByteString (ByteString)
5+import qualified Data.ByteString as B
4−import System.Exit (exitFailure)
6+import System.Exit (exitFailure)
5import System.IO
7import System.IO
6
8
7−import Bytea
8−import ExecuteMany
9−import Fold
10import Notify
9import Notify
11import Serializable
10import Serializable
12import Time
11import Time
@@ -14,12 +13,69 @@ import Time
14tests :: [TestEnv -> Test]
13tests :: [TestEnv -> Test]
15tests =
14tests =
16 [ TestLabel "Bytea" . testBytea
15 [ TestLabel "Bytea" . testBytea
17− , TestLabel "Notify" . testNotify
18 , TestLabel "ExecuteMany" . testExecuteMany
16 , TestLabel "ExecuteMany" . testExecuteMany
19 , TestLabel "Fold" . testFold
17 , TestLabel "Fold" . testFold
20− , TestLabel "Time" . testTime
18+ , TestLabel "Notify" . testNotify
21 , TestLabel "Serializable" . testSerializable
19 , TestLabel "Serializable" . testSerializable
20+ , TestLabel "Time" . testTime
21+ ]
22+
23+testBytea :: TestEnv -> Test
24+testBytea 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]
22 ]
31 ]
32+ where
33+ testStr label bytes = TestLabel label $ TestCase $ do
34+ let bs = B.pack bytes
35+
36+ [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]
37+ assertBool "Haskell -> SQL conversion altered the string" $ md5 bs == h
38+
39+ [Only (Binary r)] <- query conn "SELECT ?::bytea" [Binary bs]
40+ assertBool "SQL -> Haskell conversion altered the string" $ bs == r
41+
42+ doubleUp = concatMap (\x -> [x, x])
43+
44+testExecuteMany :: TestEnv -> Test
45+testExecuteMany TestEnv{..} = TestCase $ do
46+ execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"
47+
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+ ]
53+
54+ count <- executeMany conn "INSERT INTO tmp_executeMany VALUES (?, ?, ?)" rows
55+ count @?= fromIntegral (length rows)
56+
57+ rows' <- query_ conn "SELECT * FROM tmp_executeMany"
58+ rows' @?= rows
59+
60+ return ()
61+
62+testFold :: TestEnv -> Test
63+testFold 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])
67+
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
75+
76+ return ()
77+
78+------------------------------------------------------------------------
23
79
24-- | Action for connecting to the database that will be used for testing.
80-- | Action for connecting to the database that will be used for testing.
25--
81--
test/Serializable.hs−1
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2module Serializable (testSerializable) where
1module Serializable (testSerializable) where
3
2
4import Common
3import Common
test/Time.hs+1−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
1+{-# LANGUAGE QuasiQuotes #-}
2
2
3{-
3{-
4
4
test/WRITING-TESTS+31−23
@@ -1,34 +1,42 @@
1−Main.hs is a small wrapper around HUnit that opens a database connection and
1+Do what is EASIEST. Having a test at all is more important than,
2−starts the HUnit text-based test controller.
2+say, pretty failure output.
3
3
4−To add a new module to the test suite, do the following:
4+To add a test, open Main.hs, and add an entry to tests, e.g.:
5
5
6− * Create a new module that exports a function of type TestEnv -> Test.
6+ tests :: [TestEnv -> Test]
7− For example:
7+ tests =
8+ [ ...
9+ , TestLabel "Foo" . testFoo
10+ ]
8
11
9− module Foo (testFoo) where
12+ testFoo :: TestEnv -> Test
13+ testFoo TestEnv{..} = TestCase $ do
14+ meaningOfLife @?= 42
15+ 2013 <- getCurrentYear
16+ return ()
10
17
11− import Common
18+Mnemonic for HUnit @=? and @?= operators:
12
19
13− testFoo :: TestEnv -> Test
20+ * `?` is the value whose correctness is in question
14− testFoo TestEnv{..} = ...
15
21
16− 'TestEnv' (defined in Common.hs) contains information for accessing the
22+ * `=` is the expected value
17− database. `TestEnv{..}` is a record wildcard which brings the following
18− definitions into scope:
19
23
20− conn :: Connection
24+If you move a test to a separate module, don't forget to add it to
21− withConn :: (Connection -> IO a) -> IO a
25+"other-modules" in postgresql-simple.cabal . Otherwise, the module will be
26+left out of the tarball generated by `cabal sdist`, and tests will fail to
27+build when installing from Hackage.
22
28
23− 'conn' is a database connection shared by all the tests.
29+'TestEnv' (defined in Common.hs) contains information for accessing the
24− 'withConn' can be used to open additional connections (to the same database).
30+database. `TestEnv{..}` is a record wildcard which brings the following
31+definitions into scope:
25
32
26− 'Test' is basically a tree of 'Assertion's, where 'Assertion' is just a type
33+ conn :: Connection
27− alias for IO (). See the HLint documentation for more information.
34+ withConn :: (Connection -> IO a) -> IO a
28
35
29− * Add an entry to 'tests' in Main.hs (along with the corresponding
36+'conn' is a database connection shared by all the tests.
30− module import) so the test driver will know about the new module.
37+'withConn' can be used to open additional connections (to the same database).
31
38
32− * Add the module to postgresql-simple.cabal, under test-suite > other-modules.
39+'Test' is basically a tree of 'Assertion's, where 'Assertion' is just a type
33− Otherwise, the module will be left out of the tarball generated by
40+alias for IO (). See the [HUnit documentation][1] for more information.
34− `cabal sdist`, and tests will fail to build when installing from Hackage.
41+
42+ [1]: http://hackage.haskell.org/packages/archive/HUnit/latest/doc/html/Test-HUnit-Base.html