diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 6a80a6927..8c37579fc 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -762,7 +762,6 @@ testDuplicateMessage t = do get bob2 =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False disconnectAgentClient alice2 disconnectAgentClient bob2 - threadDelay 1000000 testSkippedMessages :: HasCallStack => ATransport -> IO () testSkippedMessages t = do @@ -1280,7 +1279,6 @@ testAsyncCommandsRestore t = do ("1", _, INV _) <- get alice' pure () disconnectAgentClient alice' - threadDelay 1000000 testAcceptContactAsync :: IO () testAcceptContactAsync = diff --git a/tests/Test.hs b/tests/Test.hs index 6493ba860..926065354 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -1,8 +1,11 @@ {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NamedFieldPuns #-} import AgentTests (agentTests) import AgentTests.SchemaDump (schemaDumpTest) import CLITests +import Control.Concurrent (threadDelay) +import qualified Control.Exception as E import Control.Logger.Simple import CoreTests.BatchingTests import CoreTests.CryptoFileTests @@ -13,6 +16,8 @@ import CoreTests.RetryIntervalTests import CoreTests.UtilTests import CoreTests.VersionRangeTests import FileDescriptionTests (fileDescriptionTests) +import GHC.IO.Exception (IOException (..)) +import qualified GHC.IO.Exception as IOException import NtfServerTests (ntfServerTests) import RemoteControl (remoteControlTests) import ServerTests @@ -36,7 +41,7 @@ main = do setEnv "APNS_KEY_FILE" "./tests/fixtures/AuthKey_H82WD9K9AQ.p8" hspec . before_ (createDirectoryIfMissing False "tests/tmp") - . after_ (removeDirectoryRecursive "tests/tmp") + . after_ (eventuallyRemove "tests/tmp" 3) $ do describe "Agent SQLite schema dump" schemaDumpTest describe "Core tests" $ do @@ -59,3 +64,12 @@ main = do describe "XFTP agent" xftpAgentTests describe "XRCP" remoteControlTests describe "Server CLIs" cliTests + +eventuallyRemove :: FilePath -> Int -> IO () +eventuallyRemove path retries = case retries of + 0 -> action + n -> action `E.catch` \ioe@IOError {ioe_type, ioe_filename} -> case ioe_type of + IOException.UnsatisfiedConstraints | ioe_filename == Just path -> threadDelay 1000000 >> eventuallyRemove path (n - 1) + _ -> E.throwIO ioe + where + action = removeDirectoryRecursive path