diff --git a/tests/Test.hs b/tests/Test.hs index cd2b0d8c31..cf2c36ddb5 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -16,6 +16,7 @@ import CoreTests.RetryIntervalTests import CoreTests.TRcvQueuesTests import CoreTests.UtilTests import CoreTests.VersionRangeTests +import Data.Maybe (fromMaybe) import FileDescriptionTests (fileDescriptionTests) import GHC.IO.Exception (IOException (..)) import qualified GHC.IO.Exception as IOException @@ -27,7 +28,10 @@ import Simplex.Messaging.Transport (TLS, Transport (..)) import Simplex.Messaging.Transport.WebSockets (WS) import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) import System.Environment (setEnv) +import System.Timeout (timeout) import Test.Hspec +import Test.Hspec.Core.Spec +import Test.Hspec.Runner (configPrintSlowItems, defaultConfig, hspecWith) import XFTPAgent import XFTPCLI import XFTPServerTests (xftpServerTests) @@ -41,9 +45,10 @@ main = do withGlobalLogging logCfg $ do setEnv "APNS_KEY_ID" "H82WD9K9AQ" setEnv "APNS_KEY_FILE" "./tests/fixtures/AuthKey_H82WD9K9AQ.p8" - hspec + hspecWith defaultConfig {configPrintSlowItems = Just 10} . before_ (createDirectoryIfMissing False "tests/tmp") . after_ (eventuallyRemove "tests/tmp" 3) + . deadline (120 * 100000) $ do describe "Agent SQLite schema dump" schemaDumpTest describe "Core tests" $ do @@ -78,3 +83,11 @@ eventuallyRemove path retries = case retries of _ -> E.throwIO ioe where action = removeDirectoryRecursive path + +-- | Abort tests after a reasonable deadline. +deadline :: Int -> SpecWith b -> SpecWith b +deadline limit = mapSpecItem_ $ \item@Item {itemLocation, itemExample} -> + item + { itemExample = \params aw pc -> + fromMaybe (Result "timed out" . Failure itemLocation $ Reason "time limit") <$> timeout limit (itemExample params aw pc) + }