@@ -1,10 +1,14 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12import Common
3+import Database.PostgreSQL.Simple.FromField (FromField)
24import Control.Exception as E
35import Control.Monad
46import Data.ByteString (ByteString)
7+import Data.Typeable
58import qualified Data.ByteString as B
69import System.Exit (exitFailure)
710import System.IO
11+import qualified Data.Vector as V
812
913import Notify
1014import Serializable
@@ -18,6 +22,7 @@ tests =
1822 , TestLabel "Notify" . testNotify
1923 , TestLabel "Serializable" . testSerializable
2024 , TestLabel "Time" . testTime
25+ , TestLabel "Array" . testArray
2126 ]
2227
2328testBytea :: TestEnv -> Test
@@ -75,6 +80,30 @@ testFold TestEnv{..} = TestCase $ do
7580
7681 return ()
7782
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+
78107------------------------------------------------------------------------
79108
80109-- | Action for connecting to the database that will be used for testing.