@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DeriveGeneric #-}
23{-# LANGUAGE DeriveDataTypeable #-}
34{-# LANGUAGE DoAndIfThenElse #-}
@@ -28,6 +29,8 @@ import Data.Text(Text)
2829import qualified Data.Text.Encoding as T
2930import qualified Data.Vector as V
3031import System.FilePath
32+import System.Timeout(timeout)
33+import Data.Time(getCurrentTime, diffUTCTime)
3134
3235import Test.Tasty
3336import Test.Tasty.Golden
@@ -57,6 +60,7 @@ tests env = testGroup "tests"
5760 , testCase "1-ary generic" . testGeneric1
5861 , testCase "2-ary generic" . testGeneric2
5962 , testCase "3-ary generic" . testGeneric3
63+ , testCase "Timeout" . testTimeout
6064 ]
6165
6266testBytea :: TestEnv -> TestTree
@@ -376,6 +380,22 @@ testCopyMalformedError TestEnv{..} =
376380 ,"2,bar\n"
377381 ,"z,baz\n"]
378382
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+
379399testDouble :: TestEnv -> Assertion
380400testDouble TestEnv{..} = do
381401 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"