From 5e385984bdc1b676dae2a38cb3ff6442ac6afca7 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 27 Nov 2023 20:44:56 -0500 Subject: [PATCH] less indentation in test suite --- ki/test/Tests.hs | 221 ++++++++++++++++++++++++----------------------- 1 file changed, 111 insertions(+), 110 deletions(-) diff --git a/ki/test/Tests.hs b/ki/test/Tests.hs index 96fec30..690c1eb 100644 --- a/ki/test/Tests.hs +++ b/ki/test/Tests.hs @@ -6,120 +6,121 @@ import Control.Exception import Control.Monad import GHC.IO (unsafeUnmask) import qualified Ki -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (testCase) import Prelude main :: IO () main = - defaultMain do - testGroup - "Unit tests" - [ testCase "`fork` throws ErrorCall when the scope is closed" do - scope <- Ki.scoped pure - (atomically . Ki.await =<< Ki.fork scope (pure ())) `shouldThrow` ErrorCall "ki: scope closed" - pure (), - testCase "`fork` throws ScopeClosing when the scope is closing" do - Ki.scoped \scope -> do - _ <- - Ki.forkWith scope Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} do - -- Naughty: catch and ignore the ScopeClosing delivered to us - result1 <- try @SomeException (threadDelay maxBound) - show result1 `shouldBe` "Left ScopeClosing" - -- Try forking a new thread in the closing scope, and assert that (synchronously) throws ScopeClosing - result2 <- try @SomeException (Ki.fork_ scope undefined) - show result2 `shouldBe` "Left ScopeClosing" - pure (), - testCase "`awaitAll` succeeds when no threads are alive" do - Ki.scoped (atomically . Ki.awaitAll), - testCase "`fork` propagates exceptions" do - (`shouldThrow` A) do - Ki.scoped \scope -> do - Ki.fork_ scope (throwIO A) - atomically (Ki.awaitAll scope), - testCase "`fork` puts exceptions after propagating" do - (`shouldThrow` A) do - Ki.scoped \scope -> do - mask \restore -> do - thread :: Ki.Thread () <- Ki.fork scope (throwIO A) - restore (atomically (Ki.awaitAll scope)) `catch` \(e :: SomeException) -> print e - atomically (Ki.await thread), - testCase "`fork` forks in unmasked state regardless of parent's masking state" do - Ki.scoped \scope -> do - _ <- Ki.fork scope (getMaskingState `shouldReturn` Unmasked) - _ <- mask_ (Ki.fork scope (getMaskingState `shouldReturn` Unmasked)) - _ <- uninterruptibleMask_ (Ki.fork scope (getMaskingState `shouldReturn` Unmasked)) - atomically (Ki.awaitAll scope), - testCase "`forkWith` can fork in interruptibly masked state regardless of paren't masking state" do - Ki.scoped \scope -> do - _ <- - Ki.forkWith - scope - Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} - (getMaskingState `shouldReturn` MaskedInterruptible) - _ <- - mask_ do - Ki.forkWith - scope - Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} - (getMaskingState `shouldReturn` MaskedInterruptible) - _ <- - uninterruptibleMask_ do - Ki.forkWith - scope - Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} - (getMaskingState `shouldReturn` MaskedInterruptible) - atomically (Ki.awaitAll scope), - testCase "`forkWith` can fork in uninterruptibly masked state regardless of paren't masking state" do - Ki.scoped \scope -> do - _ <- - Ki.forkWith - scope - Ki.defaultThreadOptions {Ki.maskingState = MaskedUninterruptible} - (getMaskingState `shouldReturn` MaskedUninterruptible) - _ <- - mask_ do - Ki.forkWith - scope - Ki.defaultThreadOptions {Ki.maskingState = MaskedUninterruptible} - (getMaskingState `shouldReturn` MaskedUninterruptible) - _ <- - uninterruptibleMask_ do - Ki.forkWith - scope - Ki.defaultThreadOptions {Ki.maskingState = MaskedUninterruptible} - (getMaskingState `shouldReturn` MaskedUninterruptible) - atomically (Ki.awaitAll scope), - testCase "`forkTry` can catch sync exceptions" do - Ki.scoped \scope -> do - result :: Ki.Thread (Either A ()) <- Ki.forkTry scope (throw A) - atomically (Ki.await result) `shouldReturn` Left A, - testCase "`forkTry` can propagate sync exceptions" do - (`shouldThrow` A) do - Ki.scoped \scope -> do - thread :: Ki.Thread (Either A2 ()) <- Ki.forkTry scope (throw A) - atomically (Ki.await thread), - testCase "`forkTry` propagates async exceptions" do - (`shouldThrow` B) do - Ki.scoped \scope -> do - thread :: Ki.Thread (Either B ()) <- Ki.forkTry scope (throw B) - atomically (Ki.await thread), - testCase "`forkTry` puts exceptions after propagating" do - (`shouldThrow` A2) do - Ki.scoped \scope -> do - mask \restore -> do - thread :: Ki.Thread (Either A ()) <- Ki.forkTry scope (throwIO A2) - restore (atomically (Ki.awaitAll scope)) `catch` \(_ :: SomeException) -> pure () - atomically (Ki.await thread), - testCase "child propagates exceptions thrown during cleanup" do - (`shouldThrow` A) do - Ki.scoped \scope -> do - ready <- newEmptyMVar - Ki.forkWith_ scope Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} do - putMVar ready () - unsafeUnmask (forever (threadDelay maxBound)) `finally` throwIO A - takeMVar ready - ] + defaultMain (testGroup "Unit tests" tests) + +tests :: [TestTree] +tests = + [ testCase "`fork` throws ErrorCall when the scope is closed" do + scope <- Ki.scoped pure + (atomically . Ki.await =<< Ki.fork scope (pure ())) `shouldThrow` ErrorCall "ki: scope closed" + pure (), + testCase "`fork` throws ScopeClosing when the scope is closing" do + Ki.scoped \scope -> do + _ <- + Ki.forkWith scope Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} do + -- Naughty: catch and ignore the ScopeClosing delivered to us + result1 <- try @SomeException (threadDelay maxBound) + show result1 `shouldBe` "Left ScopeClosing" + -- Try forking a new thread in the closing scope, and assert that (synchronously) throws ScopeClosing + result2 <- try @SomeException (Ki.fork_ scope undefined) + show result2 `shouldBe` "Left ScopeClosing" + pure (), + testCase "`awaitAll` succeeds when no threads are alive" do + Ki.scoped (atomically . Ki.awaitAll), + testCase "`fork` propagates exceptions" do + (`shouldThrow` A) do + Ki.scoped \scope -> do + Ki.fork_ scope (throwIO A) + atomically (Ki.awaitAll scope), + testCase "`fork` puts exceptions after propagating" do + (`shouldThrow` A) do + Ki.scoped \scope -> do + mask \restore -> do + thread :: Ki.Thread () <- Ki.fork scope (throwIO A) + restore (atomically (Ki.awaitAll scope)) `catch` \(_ :: SomeException) -> pure () + atomically (Ki.await thread), + testCase "`fork` forks in unmasked state regardless of parent's masking state" do + Ki.scoped \scope -> do + _ <- Ki.fork scope (getMaskingState `shouldReturn` Unmasked) + _ <- mask_ (Ki.fork scope (getMaskingState `shouldReturn` Unmasked)) + _ <- uninterruptibleMask_ (Ki.fork scope (getMaskingState `shouldReturn` Unmasked)) + atomically (Ki.awaitAll scope), + testCase "`forkWith` can fork in interruptibly masked state regardless of paren't masking state" do + Ki.scoped \scope -> do + _ <- + Ki.forkWith + scope + Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} + (getMaskingState `shouldReturn` MaskedInterruptible) + _ <- + mask_ do + Ki.forkWith + scope + Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} + (getMaskingState `shouldReturn` MaskedInterruptible) + _ <- + uninterruptibleMask_ do + Ki.forkWith + scope + Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} + (getMaskingState `shouldReturn` MaskedInterruptible) + atomically (Ki.awaitAll scope), + testCase "`forkWith` can fork in uninterruptibly masked state regardless of paren't masking state" do + Ki.scoped \scope -> do + _ <- + Ki.forkWith + scope + Ki.defaultThreadOptions {Ki.maskingState = MaskedUninterruptible} + (getMaskingState `shouldReturn` MaskedUninterruptible) + _ <- + mask_ do + Ki.forkWith + scope + Ki.defaultThreadOptions {Ki.maskingState = MaskedUninterruptible} + (getMaskingState `shouldReturn` MaskedUninterruptible) + _ <- + uninterruptibleMask_ do + Ki.forkWith + scope + Ki.defaultThreadOptions {Ki.maskingState = MaskedUninterruptible} + (getMaskingState `shouldReturn` MaskedUninterruptible) + atomically (Ki.awaitAll scope), + testCase "`forkTry` can catch sync exceptions" do + Ki.scoped \scope -> do + result :: Ki.Thread (Either A ()) <- Ki.forkTry scope (throw A) + atomically (Ki.await result) `shouldReturn` Left A, + testCase "`forkTry` can propagate sync exceptions" do + (`shouldThrow` A) do + Ki.scoped \scope -> do + thread :: Ki.Thread (Either A2 ()) <- Ki.forkTry scope (throw A) + atomically (Ki.await thread), + testCase "`forkTry` propagates async exceptions" do + (`shouldThrow` B) do + Ki.scoped \scope -> do + thread :: Ki.Thread (Either B ()) <- Ki.forkTry scope (throw B) + atomically (Ki.await thread), + testCase "`forkTry` puts exceptions after propagating" do + (`shouldThrow` A2) do + Ki.scoped \scope -> do + mask \restore -> do + thread :: Ki.Thread (Either A ()) <- Ki.forkTry scope (throwIO A2) + restore (atomically (Ki.awaitAll scope)) `catch` \(_ :: SomeException) -> pure () + atomically (Ki.await thread), + testCase "child propagates exceptions thrown during cleanup" do + (`shouldThrow` A) do + Ki.scoped \scope -> do + ready <- newEmptyMVar + Ki.forkWith_ scope Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} do + putMVar ready () + unsafeUnmask (forever (threadDelay maxBound)) `finally` throwIO A + takeMVar ready + ] data A = A deriving stock (Eq, Show)