From bbb966aa55dcecd5d505364b34c8b34ab77764f7 Mon Sep 17 00:00:00 2001 From: Guillaume Bouchard Date: Tue, 13 Aug 2024 19:29:33 +0400 Subject: [PATCH] feat: do not catch async exception as test failure This is related to https://github.com/NorfairKing/sydtest/issues/80 The current exception handler for test was incorrectly catching async exception (the handler for `AsyncException` was not enough, the "parent" of the async exception hierarchy is `SomeAsyncException`). This lead to surprising behaviors with ctrl-C. when receiving a `ctrl-c` (e.g. an interruption of the test-suite by the user), the test runner was cancelled, cancelling the print loop of the test and cancelling all workers. However, the exception was caught in workers as a "test-failure", leading to it being ignored and the different tests retrieved and meaning that the test runner survived the interruption. They will hence continue their life (e.g. purging the job queue). It was sometime leading to a lot of delay before ending the process, or even sometime other errors related to the different involved `MVar` (when no producer / consumer detection detects the error. Note that a second ctrl-c would cancels the program execution completely (Because that's how the RTS behaves). HOWEVER, the behavior is completely different in the repl, because the repl won't terminate itself on second ctrl-C. Hence the worker threads are leaked and continues running, and even survives the repl reloads. In the best case, that's a waste of resources and CPU time, but if you happen to rerun new sydtest, it can stacks and some tests may run concurrently with the "ghost" version of themself, which may or may not work ;) --- sydtest-test/default.nix | 10 +++--- sydtest-test/package.yaml | 2 ++ sydtest-test/sydtest-test.cabal | 3 ++ sydtest-test/test/Test/Syd/ExceptionSpec.hs | 37 +++++++++++++++++++++ sydtest/CHANGELOG.md | 5 +++ sydtest/src/Test/Syd/Run.hs | 9 +++-- 6 files changed, 60 insertions(+), 6 deletions(-) create mode 100644 sydtest-test/test/Test/Syd/ExceptionSpec.hs diff --git a/sydtest-test/default.nix b/sydtest-test/default.nix index 224bb84..eb41d0c 100644 --- a/sydtest-test/default.nix +++ b/sydtest-test/default.nix @@ -1,6 +1,7 @@ -{ mkDerivation, base, bytestring, fast-myers-diff, lib +{ mkDerivation, async, base, bytestring, fast-myers-diff, lib , opt-env-conf-test, path, path-io, QuickCheck, random -, safe-coloured-text, stm, sydtest, sydtest-discover, text, vector +, safe-coloured-text, stm, sydtest, sydtest-discover, text, time +, vector }: mkDerivation { pname = "sydtest-test"; @@ -8,8 +9,9 @@ mkDerivation { src = ./.; libraryHaskellDepends = [ base ]; testHaskellDepends = [ - base bytestring fast-myers-diff opt-env-conf-test path path-io - QuickCheck random safe-coloured-text stm sydtest text vector + async base bytestring fast-myers-diff opt-env-conf-test path + path-io QuickCheck random safe-coloured-text stm sydtest text time + vector ]; testToolDepends = [ sydtest-discover ]; doHaddock = false; diff --git a/sydtest-test/package.yaml b/sydtest-test/package.yaml index 467fc4e..8b46bdf 100644 --- a/sydtest-test/package.yaml +++ b/sydtest-test/package.yaml @@ -36,6 +36,8 @@ tests: - sydtest >=0.17 - text - vector + - time + - async sydtest-output-test: main: Main.hs diff --git a/sydtest-test/sydtest-test.cabal b/sydtest-test/sydtest-test.cabal index 1527dfb..2d8df90 100644 --- a/sydtest-test/sydtest-test.cabal +++ b/sydtest-test/sydtest-test.cabal @@ -88,6 +88,7 @@ test-suite sydtest-test Test.Syd.AroundSpec Test.Syd.DescriptionsSpec Test.Syd.DiffSpec + Test.Syd.ExceptionSpec Test.Syd.ExpectationSpec Test.Syd.FootgunSpec Test.Syd.GoldenSpec @@ -107,6 +108,7 @@ test-suite sydtest-test sydtest-discover:sydtest-discover build-depends: QuickCheck + , async , base >=4.7 && <5 , bytestring , fast-myers-diff @@ -117,5 +119,6 @@ test-suite sydtest-test , stm , sydtest >=0.17 , text + , time , vector default-language: Haskell2010 diff --git a/sydtest-test/test/Test/Syd/ExceptionSpec.hs b/sydtest-test/test/Test/Syd/ExceptionSpec.hs new file mode 100644 index 0000000..c282cfd --- /dev/null +++ b/sydtest-test/test/Test/Syd/ExceptionSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NumericUnderscores #-} + +module Test.Syd.ExceptionSpec where + +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async +import Data.Time.Clock +import Test.Syd + +spec :: TestDefM outers () () +spec = describe "exception handling" $ do + it "stops immediatly with async" $ do + -- Tests that when an async exception is sent to sydTest (for example, + -- ctrl-c), it behaves as expected and terminates immediately and does not + -- do anything surprising. + startTime <- liftIO getCurrentTime + + -- Runs two threads, one will be done in 1s, and the other is a test suite + -- with one test which should run for 10s. + -- When the first threads terminate, it will throw AsyncCancel in the + -- sydTest test suite, which should terminate asap. + -- This will be checked using the timer t. That's fragile, but we know that: + -- + -- t should be more than 100ms (because of the first threadDelay) + -- t should be no much more than 100ms. Especially, it should not be 10s + -- (waiting for the complete threadDelay in the test suite) or even more if + -- the exception is completly ignored (or test is retried) + _ <- race (threadDelay 100_000) $ do + sydTest $ do + it "is a dumb slow test" $ do + threadDelay 10_000_000 + + endTime <- liftIO getCurrentTime + + -- Less than 1 second + (endTime `diffUTCTime` startTime) `shouldSatisfy` (< 1) + pure () diff --git a/sydtest/CHANGELOG.md b/sydtest/CHANGELOG.md index 3cf51d8..42c359d 100644 --- a/sydtest/CHANGELOG.md +++ b/sydtest/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog +### Changed + +- sydtest won't crash anymore or behave weirdly or leak ressource in repl when + interrupted by ctrl-C. See discussion here: https://github.com/NorfairKing/sydtest/issues/80#issuecomment-2286517212 + ## [0.17.0.0] - 2024-08-04 ### Changed diff --git a/sydtest/src/Test/Syd/Run.hs b/sydtest/src/Test/Syd/Run.hs index ad86c68..5fd23c6 100644 --- a/sydtest/src/Test/Syd/Run.hs +++ b/sydtest/src/Test/Syd/Run.hs @@ -374,8 +374,13 @@ runGoldenTestWithArg createGolden TestRunSettings {..} _ wrapper = do exceptionHandlers :: [Handler (Either SomeException a)] exceptionHandlers = - [ -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT (ctrl-c). - Handler (\e -> throwIO (e :: AsyncException)), + [ -- Re-throw SomeAsyncException, otherwise execution will not terminate on SIGINT (ctrl-c). + -- This is also critical for correctness, because library such as async + -- uses this signal for `concurrently`, and `race`, ..., and if we ignore + -- this exception, we can end in a context where half of the logic has + -- stopped and yet we continue. + -- See https://github.com/NorfairKing/sydtest/issues/80 + Handler (\e -> throwIO (e :: SomeAsyncException)), -- Catch all the rest Handler (\e -> return $ Left (e :: SomeException)) ]