less indentation in test suite

awkward-squad · Nov 28, 2023 · 5e38598 · 5e38598
1 parent f551a46
commit 5e38598
Showing 1 changed file with 111 additions and 110 deletions.
diff --git 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)