git.iko.soy/typeable/postgresql-simple
on master help sign in
Regression test for timeout/withTransaction
0f5891bLeon P Smith
test/Main.hs+20
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DoAndIfThenElse #-}
4{-# LANGUAGE DoAndIfThenElse #-}
@@ -28,6 +29,8 @@ import Data.Text(Text)
28import qualified Data.Text.Encoding as T
29import qualified Data.Text.Encoding as T
29import qualified Data.Vector as V
30import qualified Data.Vector as V
30import System.FilePath
31import System.FilePath
32+import System.Timeout(timeout)
33+import Data.Time(getCurrentTime, diffUTCTime)
31
34
32import Test.Tasty
35import Test.Tasty
33import Test.Tasty.Golden
36import Test.Tasty.Golden
@@ -57,6 +60,7 @@ tests env = testGroup "tests"
57 , testCase "1-ary generic" . testGeneric1
60 , testCase "1-ary generic" . testGeneric1
58 , testCase "2-ary generic" . testGeneric2
61 , testCase "2-ary generic" . testGeneric2
59 , testCase "3-ary generic" . testGeneric3
62 , testCase "3-ary generic" . testGeneric3
63+ , testCase "Timeout" . testTimeout
60 ]
64 ]
61
65
62testBytea :: TestEnv -> TestTree
66testBytea :: TestEnv -> TestTree
@@ -376,6 +380,22 @@ testCopyMalformedError TestEnv{..} =
376 ,"2,bar\n"
380 ,"2,bar\n"
377 ,"z,baz\n"]
381 ,"z,baz\n"]
378
382
383+testTimeout :: TestEnv -> Assertion
384+testTimeout TestEnv{..} =
385+ withConn $ \c -> do
386+ start_t <- getCurrentTime
387+ res <- timeout 200000 $ do
388+ withTransaction c $ do
389+ query_ c "SELECT pg_sleep(1)" :: IO [Only ()]
390+ end_t <- getCurrentTime
391+ assertBool "Timeout did not occur" (res == Nothing)
392+#if !defined(mingw32_HOST_OS)
393+-- At the moment, you cannot timely abandon queries with async exceptions on
394+-- Windows.
395+ let d = end_t `diffUTCTime` start_t
396+ assertBool "Timeout didn't work in a timely fashion" (0.1 < d && d < 0.6)
397+#endif
398+
379testDouble :: TestEnv -> Assertion
399testDouble :: TestEnv -> Assertion
380testDouble TestEnv{..} = do
400testDouble TestEnv{..} = do
381 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"
401 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"