git.iko.soy/typeable/postgresql-simple
on master help sign in
Fix up test suite, and add Array tests
0fa69e1Leon P Smith
postgresql-simple.cabal+3
compare with master
unifiedsplit
@@ -83,6 +83,9 @@ test-suite test
83 Serializable
83 Serializable
84 Time
84 Time
85
85
86+ Build-depends:
87+ vector
88+
86 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
89 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
87
90
88 extensions: NamedFieldPuns
91 extensions: NamedFieldPuns
test/Main.hs+29
@@ -1,10 +1,14 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
1import Common
2import Common
3+import Database.PostgreSQL.Simple.FromField (FromField)
2import Control.Exception as E
4import Control.Exception as E
3import Control.Monad
5import Control.Monad
4import Data.ByteString (ByteString)
6import Data.ByteString (ByteString)
7+import Data.Typeable
5import qualified Data.ByteString as B
8import qualified Data.ByteString as B
6import System.Exit (exitFailure)
9import System.Exit (exitFailure)
7import System.IO
10import System.IO
11+import qualified Data.Vector as V
8
12
9import Notify
13import Notify
10import Serializable
14import Serializable
@@ -18,6 +22,7 @@ tests =
18 , TestLabel "Notify" . testNotify
22 , TestLabel "Notify" . testNotify
19 , TestLabel "Serializable" . testSerializable
23 , TestLabel "Serializable" . testSerializable
20 , TestLabel "Time" . testTime
24 , TestLabel "Time" . testTime
25+ , TestLabel "Array" . testArray
21 ]
26 ]
22
27
23testBytea :: TestEnv -> Test
28testBytea :: TestEnv -> Test
@@ -75,6 +80,30 @@ testFold TestEnv{..} = TestCase $ do
75
80
76 return ()
81 return ()
77
82
83+queryFailure :: forall a. (FromField a, Typeable a, Show a)
84+ => Connection -> Query -> a -> Assertion
85+queryFailure conn q resultType = do
86+ x :: Either SomeException [Only a] <- E.try $ query_ conn q
87+ case x of
88+ Left _ -> return ()
89+ Right val -> assertFailure ("Did not fail as expected: "
90+ ++ show q
91+ ++ " :: "
92+ ++ show (typeOf resultType)
93+ ++ " -> " ++ show val)
94+
95+
96+testArray :: TestEnv -> Test
97+testArray TestEnv{..} = TestCase $ do
98+ xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"
99+ xs @?= [Only (V.fromList [1,2,3,4 :: Int])]
100+ xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"
101+ xs @?= [Only (V.fromList [V.fromList [1,2],
102+ V.fromList [3,4 :: Int]])]
103+ queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)
104+ queryFailure conn "SELECT '{{1,2},{3,4}'::_int4" (undefined :: V.Vector Int)
105+
106+
78------------------------------------------------------------------------
107------------------------------------------------------------------------
79
108
80-- | Action for connecting to the database that will be used for testing.
109-- | Action for connecting to the database that will be used for testing.
test/Serializable.hs+1
@@ -4,6 +4,7 @@ import Common
4import Control.Concurrent
4import Control.Concurrent
5import Control.Exception as E
5import Control.Exception as E
6import Data.IORef
6import Data.IORef
7+import Database.PostgreSQL.Simple.Transaction
7
8
8initCounter :: Connection -> IO ()
9initCounter :: Connection -> IO ()
9initCounter conn = do
10initCounter conn = do