git.iko.soy/typeable/postgresql-simple
on master help sign in
testFold: test nested folds and exception handling
8c7629fJoey Adams
test/Main.hs+55−6
compare with master
unifiedsplit
@@ -1,4 +1,5 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DoAndIfThenElse #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3import Common
4import Common
4import Database.PostgreSQL.Simple.FromField (FromField)
5import Database.PostgreSQL.Simple.FromField (FromField)
@@ -8,6 +9,7 @@ import Control.Applicative
8import Control.Exception as E
9import Control.Exception as E
9import Control.Monad
10import Control.Monad
10import Data.ByteString (ByteString)
11import Data.ByteString (ByteString)
12+import Data.IORef
11import Data.Typeable
13import Data.Typeable
12import qualified Data.ByteString as B
14import qualified Data.ByteString as B
13import qualified Data.Map as Map
15import qualified Data.Map as Map
@@ -78,6 +80,48 @@ testFold TestEnv{..} = TestCase $ do
78 [] $ \xs (Only x) -> return (x:xs)
80 [] $ \xs (Only x) -> return (x:xs)
79 reverse xs @?= ([1..10000] :: [Int])
81 reverse xs @?= ([1..10000] :: [Int])
80
82
83+ ref <- newIORef []
84+ forEach conn "SELECT * FROM generate_series(1,?) a, generate_series(1,?) b"
85+ (100 :: Int, 50 :: Int) $ \(a :: Int, b :: Int) -> do
86+ xs <- readIORef ref
87+ writeIORef ref $! (a,b):xs
88+ xs <- readIORef ref
89+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
90+
91+ -- Make sure fold propagates our exception.
92+ ref <- newIORef []
93+ True <- expectError (== TestException) $
94+ forEach_ conn "SELECT generate_series(1,10)" $ \(Only a) ->
95+ if a == 5 then do
96+ -- Cause a SQL error to trip up CLOSE.
97+ True <- expectError isSyntaxError $
98+ execute_ conn "asdf"
99+ True <- expectError ST.isFailedTransactionError $
100+ (query_ conn "SELECT 1" :: IO [(Only Int)])
101+ throwIO TestException
102+ else do
103+ xs <- readIORef ref
104+ writeIORef ref $! (a :: Int) : xs
105+ xs <- readIORef ref
106+ reverse xs @?= [1..4]
107+
108+ withTransaction conn $ replicateM_ 2 $ do
109+ xs <- fold_ conn "VALUES (1), (2), (3), (4), (5)"
110+ [] $ \xs (Only x) -> return (x:xs)
111+ reverse xs @?= ([1..5] :: [Int])
112+
113+ ref <- newIORef []
114+ forEach_ conn "SELECT generate_series(1,101)" $ \(Only a) ->
115+ forEach_ conn "SELECT generate_series(1,55)" $ \(Only b) -> do
116+ xs <- readIORef ref
117+ writeIORef ref $! (a :: Int, b :: Int) : xs
118+ xs <- readIORef ref
119+ reverse xs @?= [(a,b) | a <- [1..101], b <- [1..55]]
120+
121+ xs <- fold_ conn "SELECT 1 WHERE FALSE"
122+ [] $ \xs (Only x) -> return (x:xs)
123+ xs @?= ([] :: [Int])
124+
81 -- TODO: add more complete tests, e.g.:
125 -- TODO: add more complete tests, e.g.:
82 --
126 --
83 -- * Fold in a transaction
127 -- * Fold in a transaction
@@ -183,18 +227,23 @@ testSavepoint TestEnv{..} = TestCase $ do
183
227
184 return ()
228 return ()
185
229
186− where
187− expectError p io =
188− (io >> return False) `E.catch` \ex ->
189− if p ex then return True else throwIO ex
190− isUniqueViolation SqlError{..} = sqlState == "23505"
191−
192data TestException
230data TestException
193 = TestException
231 = TestException
194 deriving (Eq, Show, Typeable)
232 deriving (Eq, Show, Typeable)
195
233
196instance Exception TestException
234instance Exception TestException
197
235
236+expectError :: Exception e => (e -> Bool) -> IO a -> IO Bool
237+expectError p io =
238+ (io >> return False) `E.catch` \ex ->
239+ if p ex then return True else throwIO ex
240+
241+isUniqueViolation :: SqlError -> Bool
242+isUniqueViolation SqlError{..} = sqlState == "23505"
243+
244+isSyntaxError :: SqlError -> Bool
245+isSyntaxError SqlError{..} = sqlState == "42601"
246+
198------------------------------------------------------------------------
247------------------------------------------------------------------------
199
248
200-- | Action for connecting to the database that will be used for testing.
249-- | Action for connecting to the database that will be used for testing.