git.iko.soy/typeable/postgresql-simple
on master help sign in
Make it easier to add new tests

Move simple tests into Main.hs to suggest to future test writers that it's okay to do so. Adding a module to the testsuite takes a lot of steps, and was a barrier to adding new tests. Update WRITING-TESTS accordingly.

commit84c189a7e415cc1443f40ff03caeac83ac7a2568 authorJoey Adams <joeyadams3.14159@gmail.com> dateSun 6 Jan 2013, 21:04 (14 years ago) parent36c28be
8 files changed+97−103
compare with master
unifiedsplit
postgresql-simple.cabal+1−3 test/Bytea.hs−25 test/ExecuteMany.hs−23 test/Fold.hs−19 test/Main.hs+64−8 test/Serializable.hs−1 test/Time.hs+1−1 test/WRITING-TESTS+31−23
postgresql-simple.cabal+1−3
@@ -78,9 +78,6 @@ test-suite test
7878 main-is: Main.hs
7979 other-modules:
8080 Common
81− Bytea
82− ExecuteMany
83− Fold
8481 Notify
8582 Serializable
8683 Time
@@ -92,6 +89,7 @@ test-suite test
9289 , Rank2Types
9390 , RecordWildCards
9491 , PatternGuards
92+ , ScopedTypeVariables
9593
9694 build-depends: base
9795 , 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 @@
11import Common
2−import Control.Exception (bracket)
3−import Control.Monad (when)
4−import System.Exit (exitFailure)
2+import Control.Exception as E
3+import Control.Monad
4+import Data.ByteString (ByteString)
5+import qualified Data.ByteString as B
6+import System.Exit (exitFailure)
57import System.IO
68
7−import Bytea
8−import ExecuteMany
9−import Fold
109import Notify
1110import Serializable
1211import Time
@@ -14,12 +13,69 @@ import Time
1413tests :: [TestEnv -> Test]
1514tests =
1615 [ TestLabel "Bytea" . testBytea
17− , TestLabel "Notify" . testNotify
1816 , TestLabel "ExecuteMany" . testExecuteMany
1917 , TestLabel "Fold" . testFold
20− , TestLabel "Time" . testTime
18+ , TestLabel "Notify" . testNotify
2119 , 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]
2231 ]
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+------------------------------------------------------------------------
2379
2480-- | Action for connecting to the database that will be used for testing.
2581--
test/Serializable.hs−1
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
21module Serializable (testSerializable) where
32
43import Common
test/Time.hs+1−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
1+{-# LANGUAGE QuasiQuotes #-}
22
33{-
44
test/WRITING-TESTS+31−23
@@ -1,34 +1,42 @@
1−Main.hs is a small wrapper around HUnit that opens a database connection and
2−starts the HUnit text-based test controller.
1+Do what is EASIEST. Having a test at all is more important than,
2+say, pretty failure output.
33
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.:
55
6− * Create a new module that exports a function of type TestEnv -> Test.
7− For example:
6+ tests :: [TestEnv -> Test]
7+ tests =
8+ [ ...
9+ , TestLabel "Foo" . testFoo
10+ ]
811
9− module Foo (testFoo) where
12+ testFoo :: TestEnv -> Test
13+ testFoo TestEnv{..} = TestCase $ do
14+ meaningOfLife @?= 42
15+ 2013 <- getCurrentYear
16+ return ()
1017
11− import Common
18+Mnemonic for HUnit @=? and @?= operators:
1219
13− testFoo :: TestEnv -> Test
14− testFoo TestEnv{..} = ...
20+ * `?` is the value whose correctness is in question
1521
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:
22+ * `=` is the expected value
1923
20− conn :: Connection
21− withConn :: (Connection -> IO a) -> IO a
24+If you move a test to a separate module, don't forget to add it to
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.
2228
23− 'conn' is a database connection shared by all the tests.
24− 'withConn' can be used to open additional connections (to the same database).
29+'TestEnv' (defined in Common.hs) contains information for accessing the
30+database. `TestEnv{..}` is a record wildcard which brings the following
31+definitions into scope:
2532
26− 'Test' is basically a tree of 'Assertion's, where 'Assertion' is just a type
27− alias for IO (). See the HLint documentation for more information.
33+ conn :: Connection
34+ withConn :: (Connection -> IO a) -> IO a
2835
29− * Add an entry to 'tests' in Main.hs (along with the corresponding
30− module import) so the test driver will know about the new module.
36+'conn' is a database connection shared by all the tests.
37+'withConn' can be used to open additional connections (to the same database).
3138
32− * Add the module to postgresql-simple.cabal, under test-suite > other-modules.
33− Otherwise, the module will be left out of the tarball generated by
34− `cabal sdist`, and tests will fail to build when installing from Hackage.
39+'Test' is basically a tree of 'Assertion's, where 'Assertion' is just a type
40+alias for IO (). See the [HUnit documentation][1] for more information.
41+
42+ [1]: http://hackage.haskell.org/packages/archive/HUnit/latest/doc/html/Test-HUnit-Base.html