d7735cb · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Merge pull request #185 from bgamari/copy-error-tests

d7735cbLeon P Smith10 years ago

postgresql-simple.cabal+4

compare with master

unifiedsplit

@@ -115,6 +115,10 @@ test-suite test

115 , bytestring

116 , containers

117 , cryptohash

118+ , filepath

119+ , tasty

120+ , tasty-hunit

121+ , tasty-golden

118 , HUnit

122 , HUnit

119 , postgresql-simple

123 , postgresql-simple

120 , text

124 , text

test/Common.hs+2−2

@@ -1,6 +1,6 @@

1module Common (

2 module Database.PostgreSQL.Simple,

3− module Test.HUnit,

3+ module Test.Tasty.HUnit,

4 TestEnv(..),

5 md5,

6) where

@@ -8,7 +8,7 @@ module Common (

8import Data.ByteString (ByteString)

9import Data.Text (Text)

10import Database.PostgreSQL.Simple

11−import Test.HUnit

11+import Test.Tasty.HUnit

13import qualified Crypto.Hash.MD5 as MD5

14import qualified Data.ByteString.Base16 as Base16

test/Main.hs+107−59

@@ -8,51 +8,58 @@ import Database.PostgreSQL.Simple.Types(Query(..),Values(..))

8import Database.PostgreSQL.Simple.HStore

9import Database.PostgreSQL.Simple.Copy

10import qualified Database.PostgreSQL.Simple.Transaction as ST

11+

11import Control.Applicative

12import Control.Applicative

12import Control.Exception as E

13import Control.Exception as E

13import Control.Monad

14import Control.Monad

14−import Data.ByteString (ByteString)

15+import Data.Char

16+import Data.List (sort)

15import Data.IORef

17import Data.IORef

16import Data.Typeable

18import Data.Typeable

19+import GHC.Generics (Generic)

20+

21+import Data.Aeson

22+import Data.ByteString (ByteString)

17import qualified Data.ByteString as B

23import qualified Data.ByteString as B

24+import qualified Data.ByteString.Lazy.Char8 as BL

18import Data.Map (Map)

25import Data.Map (Map)

19−import Data.List (sort)

20import qualified Data.Map as Map

26import qualified Data.Map as Map

21import Data.Text(Text)

27import Data.Text(Text)

22import qualified Data.Text.Encoding as T

28import qualified Data.Text.Encoding as T

23−import System.Exit (exitFailure)

24−import System.IO

25import qualified Data.Vector as V

29import qualified Data.Vector as V

26−import Data.Aeson

30+import System.FilePath

27−import GHC.Generics (Generic)

32+import Test.Tasty

33+import Test.Tasty.Golden

29import Notify

34import Notify

30import Serializable

35import Serializable

31import Time

36import Time

33−tests :: [TestEnv -> Test]

38+tests :: TestEnv -> TestTree

34−tests =

39+tests env = testGroup "tests"

40+ $ map ($ env)

35− [ TestLabel "Bytea" . testBytea

41+ [ testBytea

36− , TestLabel "ExecuteMany" . testExecuteMany

42+ , testCase "ExecuteMany" . testExecuteMany

37− , TestLabel "Fold" . testFold

43+ , testCase "Fold" . testFold

38− , TestLabel "Notify" . testNotify

44+ , testCase "Notify" . testNotify

39− , TestLabel "Serializable" . testSerializable

45+ , testCase "Serializable" . testSerializable

40− , TestLabel "Time" . testTime

46+ , testCase "Time" . testTime

41− , TestLabel "Array" . testArray

47+ , testCase "Array" . testArray

42− , TestLabel "HStore" . testHStore

48+ , testCase "HStore" . testHStore

43− , TestLabel "JSON" . testJSON

49+ , testCase "JSON" . testJSON

44− , TestLabel "Savepoint" . testSavepoint

50+ , testCase "Savepoint" . testSavepoint

45− , TestLabel "Unicode" . testUnicode

51+ , testCase "Unicode" . testUnicode

46− , TestLabel "Values" . testValues

52+ , testCase "Values" . testValues

47− , TestLabel "Copy" . testCopy

53+ , testCase "Copy" . testCopy

54+ , testCopyFailures

48− , TestLabel "Double" . testDouble

55+ , testCase "Double" . testDouble

49− , TestLabel "1-ary generic" . testGeneric1

56+ , testCase "1-ary generic" . testGeneric1

50− , TestLabel "2-ary generic" . testGeneric2

57+ , testCase "2-ary generic" . testGeneric2

51− , TestLabel "3-ary generic" . testGeneric3

58+ , testCase "3-ary generic" . testGeneric3

52 ]

59 ]

54−testBytea :: TestEnv -> Test

61+testBytea :: TestEnv -> TestTree

55−testBytea TestEnv{..} = TestList

62+testBytea TestEnv{..} = testGroup "Bytea"

56 [ testStr "empty" []

63 [ testStr "empty" []

57 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

64 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

58 , testStr "ascending" [0..255]

65 , testStr "ascending" [0..255]

@@ -61,7 +68,7 @@ testBytea TestEnv{..} = TestList

61 , testStr "descending, doubled up" $ doubleUp [255,254..0]

68 , testStr "descending, doubled up" $ doubleUp [255,254..0]

62 ]

69 ]

63 where

70 where

64− testStr label bytes = TestLabel label $ TestCase $ do

71+ testStr label bytes = testCase label $ do

65 let bs = B.pack bytes

72 let bs = B.pack bytes

67 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]

74 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]

@@ -72,8 +79,8 @@ testBytea TestEnv{..} = TestList

73 doubleUp = concatMap (\x -> [x, x])

80 doubleUp = concatMap (\x -> [x, x])

75−testExecuteMany :: TestEnv -> Test

82+testExecuteMany :: TestEnv -> Assertion

76−testExecuteMany TestEnv{..} = TestCase $ do

83+testExecuteMany TestEnv{..} = do

77 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"

84 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"

79 let rows :: [(Int, String, Binary ByteString)]

86 let rows :: [(Int, String, Binary ByteString)]

@@ -90,8 +97,8 @@ testExecuteMany TestEnv{..} = TestCase $ do

91 return ()

98 return ()

93−testFold :: TestEnv -> Test

100+testFold :: TestEnv -> Assertion

94−testFold TestEnv{..} = TestCase $ do

101+testFold TestEnv{..} = do

95 xs <- fold_ conn "SELECT generate_series(1,10000)"

102 xs <- fold_ conn "SELECT generate_series(1,10000)"

96 [] $ \xs (Only x) -> return (x:xs)

103 [] $ \xs (Only x) -> return (x:xs)

97 reverse xs @?= ([1..10000] :: [Int])

104 reverse xs @?= ([1..10000] :: [Int])

@@ -160,8 +167,8 @@ queryFailure conn q resultType = do

160 ++ show (typeOf resultType)

167 ++ show (typeOf resultType)

161 ++ " -> " ++ show val)

168 ++ " -> " ++ show val)

162

169

163−testArray :: TestEnv -> Test

170+testArray :: TestEnv -> Assertion

164−testArray TestEnv{..} = TestCase $ do

171+testArray TestEnv{..} = do

165 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"

172 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"

166 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]

173 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]

167 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"

174 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"

@@ -170,8 +177,8 @@ testArray TestEnv{..} = TestCase $ do

170 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)

177 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)

171 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)

178 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)

172

179

173−testHStore :: TestEnv -> Test

180+testHStore :: TestEnv -> Assertion

174−testHStore TestEnv{..} = TestCase $ do

181+testHStore TestEnv{..} = do

175 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"

182 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"

176 roundTrip []

183 roundTrip []

177 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]

184 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]

@@ -183,8 +190,8 @@ testHStore TestEnv{..} = TestCase $ do

183 m' <- query conn "SELECT ?::hstore" m

190 m' <- query conn "SELECT ?::hstore" m

184 [m] @?= m'

191 [m] @?= m'

185

192

186−testJSON :: TestEnv -> Test

193+testJSON :: TestEnv -> Assertion

187−testJSON TestEnv{..} = TestCase $ do

194+testJSON TestEnv{..} = do

188 roundTrip (Map.fromList [] :: Map Text Text)

195 roundTrip (Map.fromList [] :: Map Text Text)

189 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

196 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

190 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

197 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

@@ -198,8 +205,8 @@ testJSON TestEnv{..} = TestCase $ do

198 js' <- query conn "SELECT ?::json" js

205 js' <- query conn "SELECT ?::json" js

199 [js] @?= js'

206 [js] @?= js'

200

207

201−testSavepoint :: TestEnv -> Test

208+testSavepoint :: TestEnv -> Assertion

202−testSavepoint TestEnv{..} = TestCase $ do

209+testSavepoint TestEnv{..} = do

203 True <- expectError ST.isNoActiveTransactionError $

210 True <- expectError ST.isNoActiveTransactionError $

204 withSavepoint conn $ return ()

211 withSavepoint conn $ return ()

205

212

@@ -259,8 +266,8 @@ testSavepoint TestEnv{..} = TestCase $ do

259

266

260 return ()

267 return ()

261

268

262−testUnicode :: TestEnv -> Test

269+testUnicode :: TestEnv -> Assertion

263−testUnicode TestEnv{..} = TestCase $ do

270+testUnicode TestEnv{..} = do

264 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure

271 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure

265 -- the table gets created correctly.

272 -- the table gets created correctly.

266 let messages = map Only ["привет","мир"] :: [Only Text]

273 let messages = map Only ["привет","мир"] :: [Only Text]

@@ -269,8 +276,8 @@ testUnicode TestEnv{..} = TestCase $ do

269 messages' <- query_ conn "SELECT сообщение FROM ру́сский"

276 messages' <- query_ conn "SELECT сообщение FROM ру́сский"

270 sort messages @?= sort messages'

277 sort messages @?= sort messages'

271

278

272−testValues :: TestEnv -> Test

279+testValues :: TestEnv -> Assertion

273−testValues TestEnv{..} = TestCase $ do

280+testValues TestEnv{..} = do

274 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"

281 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"

275 test (Values ["int4","text"] [])

282 test (Values ["int4","text"] [])

276 test (Values ["int4","text"] [(1,"hello")])

283 test (Values ["int4","text"] [(1,"hello")])

@@ -287,8 +294,8 @@ testValues TestEnv{..} = TestCase $ do

287 sort vals @?= sort vals'

294 sort vals @?= sort vals'

288

295

289

296

290−testCopy :: TestEnv -> Test

297+testCopy :: TestEnv -> Assertion

291−testCopy TestEnv{..} = TestCase $ do

298+testCopy TestEnv{..} = do

292 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"

299 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"

293 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"

300 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"

294 mapM_ (putCopyData conn) copyRows

301 mapM_ (putCopyData conn) copyRows

@@ -315,8 +322,53 @@ testCopy TestEnv{..} = TestCase $ do

315 CopyOutDone _ -> return rows

322 CopyOutDone _ -> return rows

316 CopyOutRow row -> loop (row:rows)

323 CopyOutRow row -> loop (row:rows)

317

324

318−testDouble :: TestEnv -> Test

325+testCopyFailures :: TestEnv -> TestTree

319−testDouble TestEnv{..} = TestCase $ do

326+testCopyFailures env = testGroup "Copy failures"

327+ $ map ($ env)

328+ [ testCopyUniqueConstraintError

329+ , testCopyMalformedError

330+ ]

331+

332+goldenTest :: TestName -> IO BL.ByteString -> TestTree

333+goldenTest testName =

334+ goldenVsString testName (resultsDir </> fileName<.>"expected")

335+ where

336+ resultsDir = "test" </> "results"

337+ fileName = map normalize testName

338+ normalize c | not (isAlpha c) = '-'

339+ | otherwise = c

340+

341+-- | Test that we provide a sensible error message on failure

342+testCopyUniqueConstraintError :: TestEnv -> TestTree

343+testCopyUniqueConstraintError TestEnv{..} =

344+ goldenTest "unique constraint violation"

345+ $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do

346+ execute_ conn "CREATE TEMPORARY TABLE copy_unique_constraint_error_test (x int PRIMARY KEY, y text)"

347+ copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"

348+ mapM_ (putCopyData conn) copyRows

349+ _n <- putCopyEnd conn

350+ return BL.empty

351+ where

352+ copyRows = ["1,foo\n"

353+ ,"2,bar\n"

354+ ,"1,baz\n"]

355+

356+testCopyMalformedError :: TestEnv -> TestTree

357+testCopyMalformedError TestEnv{..} =

358+ goldenTest "malformed input"

359+ $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do

360+ execute_ conn "CREATE TEMPORARY TABLE copy_malformed_input_error_test (x int PRIMARY KEY, y text)"

361+ copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"

362+ mapM_ (putCopyData conn) copyRows

363+ _n <- putCopyEnd conn

364+ return BL.empty

365+ where

366+ copyRows = ["1,foo\n"

367+ ,"2,bar\n"

368+ ,"z,baz\n"]

369+

370+testDouble :: TestEnv -> Assertion

371+testDouble TestEnv{..} = do

320 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"

372 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"

321 assertBool "expected NaN" (isNaN x)

373 assertBool "expected NaN" (isNaN x)

322 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"

374 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"

@@ -325,24 +377,24 @@ testDouble TestEnv{..} = TestCase $ do

325 x @?= (-1 / 0)

377 x @?= (-1 / 0)

326

378

327

379

328−testGeneric1 :: TestEnv -> Test

380+testGeneric1 :: TestEnv -> Assertion

329−testGeneric1 TestEnv{..} = TestCase $ do

381+testGeneric1 TestEnv{..} = do

330 roundTrip conn (Gen1 123)

382 roundTrip conn (Gen1 123)

331 where

383 where

332 roundTrip conn x0 = do

384 roundTrip conn x0 = do

333 r <- query conn "SELECT ?::int" (x0 :: Gen1)

385 r <- query conn "SELECT ?::int" (x0 :: Gen1)

334 r @?= [x0]

386 r @?= [x0]

335

387

336−testGeneric2 :: TestEnv -> Test

388+testGeneric2 :: TestEnv -> Assertion

337−testGeneric2 TestEnv{..} = TestCase $ do

389+testGeneric2 TestEnv{..} = do

338 roundTrip conn (Gen2 123 "asdf")

390 roundTrip conn (Gen2 123 "asdf")

339 where

391 where

340 roundTrip conn x0 = do

392 roundTrip conn x0 = do

341 r <- query conn "SELECT ?::int, ?::text" x0

393 r <- query conn "SELECT ?::int, ?::text" x0

342 r @?= [x0]

394 r @?= [x0]

343

395

344−testGeneric3 :: TestEnv -> Test

396+testGeneric3 :: TestEnv -> Assertion

345−testGeneric3 TestEnv{..} = TestCase $ do

397+testGeneric3 TestEnv{..} = do

346 roundTrip conn (Gen3 123 "asdf" True)

398 roundTrip conn (Gen3 123 "asdf" True)

347 where

399 where

348 roundTrip conn x0 = do

400 roundTrip conn x0 = do

@@ -401,8 +453,4 @@ withTestEnv cb =

401 withConn = bracket testConnect close

453 withConn = bracket testConnect close

402

454

403main :: IO ()

455main :: IO ()

404−main = do

405− mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]

406− Counts{cases, tried, errors, failures} <-

407− withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests

456+main = withTestEnv $ defaultMain . tests

408− when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure

test/Notify.hs+1−2

@@ -14,9 +14,8 @@ import qualified Data.ByteString as B

14-- TODO: Test with payload, but only for PostgreSQL >= 9.0

15-- (when that feature was introduced).

17−testNotify :: TestEnv -> Test

17+testNotify :: TestEnv -> Assertion

18testNotify TestEnv{..} =

19− TestCase $

20 withConn $ \conn2 -> do

19 withConn $ \conn2 -> do

21 execute_ conn "LISTEN foo"

20 execute_ conn "LISTEN foo"

22 execute_ conn "LISTEN bar"

21 execute_ conn "LISTEN bar"

test/Serializable.hs+1−2

@@ -23,9 +23,8 @@ putCounter conn n = do

23 1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)

24 return ()

26−testSerializable :: TestEnv -> Test

26+testSerializable :: TestEnv -> Assertion

27testSerializable TestEnv{..} =

28− TestCase $

29 withConn $ \conn2 -> do

28 withConn $ \conn2 -> do

30 initCounter conn

29 initCounter conn

test/Time.hs+2−2

@@ -43,8 +43,8 @@ import Database.PostgreSQL.Simple.SqlQQ

43numTests :: Int

44numTests = 200

46−testTime :: TestEnv -> Test

46+testTime :: TestEnv -> Assertion

47−testTime env@TestEnv{..} = TestCase $ do

47+testTime env@TestEnv{..} = do

48 initializeTable env

49 execute_ conn "SET timezone TO 'UTC'"

50 checkRoundTrips env "1860-01-01 00:00:00+00"

test/results/malformed-input.expectednew file+4

@@ -0,0 +1,4 @@

1+user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2+Connection error: ERROR: invalid input syntax for integer: "z"

3+CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

4+)

test/results/unique-constraint-violation.expectednew file+5

@@ -0,0 +1,5 @@

1+user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2+Connection error: ERROR: duplicate key value violates unique constraint "copy_unique_constraint_error_test_pkey"

3+DETAIL: Key (x)=(1) already exists.

4+CONTEXT: COPY copy_unique_constraint_error_test, line 3

5+)