packages feed

sydtest 0.11.0.2 → 0.12.0.0

raw patch · 22 files changed

+2182/−530 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Test.Syd.Modify: MayBeFlakyUpTo :: !Int -> !Maybe String -> FlakinessMode
- Test.Syd.Output: outputFailure :: TestRunResult -> Maybe [[Chunk]]
- Test.Syd.Run: [testRunResultFlakinessMessage] :: TestRunResult -> !Maybe String
- Test.Syd.Run: [testRunResultRetries] :: TestRunResult -> !Maybe Int
- Test.Syd.Runner.Asynchronous: makeHandleForest :: TestForest a b -> IO (HandleForest a b)
- Test.Syd.Runner.Asynchronous: printer :: Settings -> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
- Test.Syd.Runner.Asynchronous: runner :: Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
- Test.Syd.Runner.Asynchronous: type HandleForest a b = SpecDefForest a b (MVar (Timed TestRunResult))
- Test.Syd.Runner.Asynchronous: type HandleTree a b = SpecDefTree a b (MVar (Timed TestRunResult))
- Test.Syd.Runner.Asynchronous: waiter :: MVar () -> HandleForest '[] () -> IO ResultForest
- Test.Syd.Runner.Synchronous: runSingleTestWithFlakinessMode :: forall a t. ProgressReporter -> HList a -> TDef (ProgressReporter -> ((HList a -> () -> t) -> t) -> IO TestRunResult) -> FlakinessMode -> IO TestRunResult
- Test.Syd.SpecDef: MayBeFlakyUpTo :: !Int -> !Maybe String -> FlakinessMode
- Test.Syd.SpecDef: testFailed :: Settings -> TestRunResult -> Bool
+ Test.Syd: ExpectFailing :: ExpectationMode
+ Test.Syd: ExpectPassing :: ExpectationMode
+ Test.Syd: MayBeFlaky :: !Maybe String -> FlakinessMode
+ Test.Syd: MayNotBeFlaky :: FlakinessMode
+ Test.Syd: [DefExpectationNode] :: ExpectationMode -> SpecDefForest outers inner extra -> SpecDefTree outers inner extra
+ Test.Syd: [DefRetriesNode] :: (Word -> Word) -> SpecDefForest outers inner extra -> SpecDefTree outers inner extra
+ Test.Syd: data ExpectationMode
+ Test.Syd: data FlakinessMode
+ Test.Syd: expectFailing :: TestDefM a b c -> TestDefM a b c
+ Test.Syd: expectPassing :: TestDefM a b c -> TestDefM a b c
+ Test.Syd: flaky :: Word -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: flakyWith :: Word -> String -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: modifyRetries :: (Word -> Word) -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: notFlaky :: TestDefM a b c -> TestDefM a b c
+ Test.Syd: pPrint :: Show a => a -> IO ()
+ Test.Syd: potentiallyFlaky :: TestDefM a b c -> TestDefM a b c
+ Test.Syd: potentiallyFlakyWith :: String -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: withExpectationMode :: ExpectationMode -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: withFlakiness :: FlakinessMode -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: withRetries :: Word -> TestDefM a b c -> TestDefM a b c
+ Test.Syd: withoutRetries :: TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: ExpectFailing :: ExpectationMode
+ Test.Syd.Modify: ExpectPassing :: ExpectationMode
+ Test.Syd.Modify: MayBeFlaky :: !Maybe String -> FlakinessMode
+ Test.Syd.Modify: data ExpectationMode
+ Test.Syd.Modify: expectFailing :: TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: expectPassing :: TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: modifyRetries :: (Word -> Word) -> TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: potentiallyFlaky :: TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: potentiallyFlakyWith :: String -> TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: withExpectationMode :: ExpectationMode -> TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: withRetries :: Word -> TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: withoutRetries :: TestDefM a b c -> TestDefM a b c
+ Test.Syd.OptParse: [configRetries] :: Configuration -> !Maybe Word
+ Test.Syd.OptParse: [envRetries] :: Environment -> !Maybe Word
+ Test.Syd.OptParse: [flagRetries] :: Flags -> !Maybe Word
+ Test.Syd.OptParse: [settingRetries] :: Settings -> !Word
+ Test.Syd.OptParse: defaultRetries :: Word
+ Test.Syd.Runner: setPseudorandomness :: SeedSetting -> IO ()
+ Test.Syd.Runner.Single: runSingleTestWithFlakinessMode :: forall externalResources t. ProgressReporter -> HList externalResources -> TDef (ProgressReporter -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult) -> Word -> FlakinessMode -> ExpectationMode -> IO TestRunReport
+ Test.Syd.Runner.Synchronous.Interleaved: runSpecForestInterleavedWithOutputSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest)
+ Test.Syd.Runner.Synchronous.Separate: runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest
+ Test.Syd.SpecDef: ExpectFailing :: ExpectationMode
+ Test.Syd.SpecDef: ExpectPassing :: ExpectationMode
+ Test.Syd.SpecDef: MayBeFlaky :: !Maybe String -> FlakinessMode
+ Test.Syd.SpecDef: TestRunReport :: !ExpectationMode -> !NonEmpty TestRunResult -> !FlakinessMode -> TestRunReport
+ Test.Syd.SpecDef: [DefExpectationNode] :: ExpectationMode -> SpecDefForest outers inner extra -> SpecDefTree outers inner extra
+ Test.Syd.SpecDef: [DefRetriesNode] :: (Word -> Word) -> SpecDefForest outers inner extra -> SpecDefTree outers inner extra
+ Test.Syd.SpecDef: [testRunReportExpectationMode] :: TestRunReport -> !ExpectationMode
+ Test.Syd.SpecDef: [testRunReportFlakinessMode] :: TestRunReport -> !FlakinessMode
+ Test.Syd.SpecDef: [testRunReportRawResults] :: TestRunReport -> !NonEmpty TestRunResult
+ Test.Syd.SpecDef: data ExpectationMode
+ Test.Syd.SpecDef: data TestRunReport
+ Test.Syd.SpecDef: instance GHC.Classes.Eq Test.Syd.SpecDef.ExecutionOrderRandomisation
+ Test.Syd.SpecDef: instance GHC.Classes.Eq Test.Syd.SpecDef.ExpectationMode
+ Test.Syd.SpecDef: instance GHC.Classes.Eq Test.Syd.SpecDef.FlakinessMode
+ Test.Syd.SpecDef: instance GHC.Classes.Eq Test.Syd.SpecDef.Parallelism
+ Test.Syd.SpecDef: instance GHC.Generics.Generic Test.Syd.SpecDef.ExecutionOrderRandomisation
+ Test.Syd.SpecDef: instance GHC.Generics.Generic Test.Syd.SpecDef.ExpectationMode
+ Test.Syd.SpecDef: instance GHC.Generics.Generic Test.Syd.SpecDef.FlakinessMode
+ Test.Syd.SpecDef: instance GHC.Generics.Generic Test.Syd.SpecDef.Parallelism
+ Test.Syd.SpecDef: instance GHC.Generics.Generic Test.Syd.SpecDef.TestRunReport
+ Test.Syd.SpecDef: instance GHC.Show.Show Test.Syd.SpecDef.ExecutionOrderRandomisation
+ Test.Syd.SpecDef: instance GHC.Show.Show Test.Syd.SpecDef.ExpectationMode
+ Test.Syd.SpecDef: instance GHC.Show.Show Test.Syd.SpecDef.FlakinessMode
+ Test.Syd.SpecDef: instance GHC.Show.Show Test.Syd.SpecDef.Parallelism
+ Test.Syd.SpecDef: instance GHC.Show.Show Test.Syd.SpecDef.TestRunReport
+ Test.Syd.SpecDef: markSpecForestAsPending :: Maybe Text -> SpecDefForest outers inner result -> SpecDefForest outers inner result
+ Test.Syd.SpecDef: testRunReportExamples :: TestRunReport -> Word
+ Test.Syd.SpecDef: testRunReportFailed :: Settings -> TestRunReport -> Bool
+ Test.Syd.SpecDef: testRunReportReportedRun :: TestRunReport -> TestRunResult
+ Test.Syd.SpecDef: testRunReportRetries :: TestRunReport -> Maybe Word
+ Test.Syd.SpecDef: testRunReportStatus :: Settings -> TestRunReport -> TestStatus
+ Test.Syd.SpecDef: testRunReportWasFlaky :: TestRunReport -> Bool
+ Test.Syd.SpecDef: testRunResultExamples :: TestRunResult -> Word
+ Test.Syd.SpecDef: testStatusMatchesExpectationMode :: TestStatus -> ExpectationMode -> Bool
- Test.Syd: type ResultForest = SpecForest (TDef (Timed TestRunResult))
+ Test.Syd: type ResultForest = SpecForest (TDef (Timed TestRunReport))
- Test.Syd: type ResultTree = SpecTree (TDef (Timed TestRunResult))
+ Test.Syd: type ResultTree = SpecTree (TDef (Timed TestRunReport))
- Test.Syd.Modify: flaky :: Int -> TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: flaky :: Word -> TestDefM a b c -> TestDefM a b c
- Test.Syd.Modify: flakyWith :: Int -> String -> TestDefM a b c -> TestDefM a b c
+ Test.Syd.Modify: flakyWith :: Word -> String -> TestDefM a b c -> TestDefM a b c
- Test.Syd.OptParse: Configuration :: !Maybe SeedSetting -> !Maybe Bool -> !Maybe Threads -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> !Maybe Text -> !Maybe Bool -> !Maybe Iterations -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> Configuration
+ Test.Syd.OptParse: Configuration :: !Maybe SeedSetting -> !Maybe Bool -> !Maybe Threads -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> !Maybe Text -> !Maybe Bool -> !Maybe Iterations -> !Maybe Word -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> Configuration
- Test.Syd.OptParse: Environment :: Maybe FilePath -> !Maybe SeedSetting -> !Maybe Bool -> !Maybe Threads -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> !Maybe Text -> !Maybe Bool -> !Maybe Iterations -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> Environment
+ Test.Syd.OptParse: Environment :: Maybe FilePath -> !Maybe SeedSetting -> !Maybe Bool -> !Maybe Threads -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> !Maybe Text -> !Maybe Bool -> !Maybe Iterations -> !Maybe Word -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> Environment
- Test.Syd.OptParse: Flags :: !Maybe FilePath -> !Maybe SeedSetting -> !Maybe Bool -> !Maybe Threads -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> !Maybe Text -> !Maybe Bool -> !Maybe Iterations -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> Flags
+ Test.Syd.OptParse: Flags :: !Maybe FilePath -> !Maybe SeedSetting -> !Maybe Bool -> !Maybe Threads -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Int -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> !Maybe Text -> !Maybe Bool -> !Maybe Iterations -> !Maybe Word -> !Maybe Bool -> !Maybe Bool -> !Maybe Bool -> Flags
- Test.Syd.OptParse: Settings :: !SeedSetting -> !Bool -> !Threads -> !Int -> !Int -> !Int -> !Int -> !Bool -> !Bool -> !Maybe Bool -> !Maybe Text -> !Bool -> Iterations -> !Bool -> !ReportProgress -> !Bool -> Settings
+ Test.Syd.OptParse: Settings :: !SeedSetting -> !Bool -> !Threads -> !Int -> !Int -> !Int -> !Int -> !Bool -> !Bool -> !Maybe Bool -> !Maybe Text -> !Bool -> !Iterations -> !Word -> !Bool -> !ReportProgress -> !Bool -> Settings
- Test.Syd.OptParse: [settingIterations] :: Settings -> Iterations
+ Test.Syd.OptParse: [settingIterations] :: Settings -> !Iterations
- Test.Syd.Output: outputSpecForest :: Int -> Int -> ResultForest -> [[Chunk]]
+ Test.Syd.Output: outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]
- Test.Syd.Output: outputSpecTree :: Int -> Int -> ResultTree -> [[Chunk]]
+ Test.Syd.Output: outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]
- Test.Syd.Output: outputSpecifyLines :: Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]
+ Test.Syd.Output: outputSpecifyLines :: Settings -> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
- Test.Syd.Output: retriesChunks :: TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]
+ Test.Syd.Output: retriesChunks :: TestRunReport -> [[Chunk]]
- Test.Syd.Run: TestRunResult :: !TestStatus -> !Maybe Int -> !Maybe SomeException -> !Maybe Word -> !Maybe Word -> [String] -> !Maybe (Map [String] Int) -> !Maybe (Map String Int) -> !Maybe (Map String (Map String Int)) -> !Maybe GoldenCase -> !Maybe String -> !Maybe String -> TestRunResult
+ Test.Syd.Run: TestRunResult :: !TestStatus -> !Maybe SomeException -> !Maybe Word -> !Maybe Word -> [String] -> !Maybe (Map [String] Int) -> !Maybe (Map String Int) -> !Maybe (Map String (Map String Int)) -> !Maybe GoldenCase -> !Maybe String -> TestRunResult
- Test.Syd.Runner.Wrappers: failFastNext :: Bool -> TDef (Timed TestRunResult) -> Next (TDef (Timed TestRunResult))
+ Test.Syd.Runner.Wrappers: failFastNext :: Settings -> TDef (Timed TestRunReport) -> Next (TDef (Timed TestRunReport))
- Test.Syd.SpecDef: computeTestSuiteStats :: ResultForest -> TestSuiteStats
+ Test.Syd.SpecDef: computeTestSuiteStats :: Settings -> ResultForest -> TestSuiteStats
- Test.Syd.SpecDef: type ResultForest = SpecForest (TDef (Timed TestRunResult))
+ Test.Syd.SpecDef: type ResultForest = SpecForest (TDef (Timed TestRunReport))
- Test.Syd.SpecDef: type ResultTree = SpecTree (TDef (Timed TestRunResult))
+ Test.Syd.SpecDef: type ResultTree = SpecTree (TDef (Timed TestRunReport))

Files

CHANGELOG.md view
@@ -1,5 +1,29 @@ # Changelog +## [0.12.0.0] - Unreleased++### Added++* Automatic flakiness diagnostics, see the `README`+  This adds the `potentiallyFlaky` and `potentiallyFlakyWith` functions.+* `Test.Syd` now also exports `pPrint`.+* The `modifyRetries`, `withoutRetries`, `withRetries` functions, to allow configuration of the number of retries independently of whether flakiness is allowed.+* The `TestRunReport` type, so that a `ResultForest` contains information about all runs of a test instead of only the last.+* Expectation of failure.+  This adds the `expectFailing`, `expectPassing`, and `withExpectationMode` functions.++### Changed++* Fixed: Fail-fast now works correctly together with fail-on-flaky+* Fixed that flags with a `no-` prefix did not parse correctly and could therefore not be used.+* The `FlakinessMode` type no longer contains a number of retries.+  The number of retries is now configured separately.+* Fixed that `xdescribe` would only result in one pending test instead of the same number of tests as are marked as pending.+* Fixed that `specify` and `prop` would show a callstack from inside `sydtest` instead of from where you used them.+* Sydtest now sets the global pseudorandomness seed in the random library to the given seed using `setStdGen` for extra reproducability.++### Removed+ ## [0.11.0.2] - 2022-09-7  ### Changed
+ output-test/Main.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-missing-methods -fno-warn-partial-fields -fno-warn-incomplete-uni-patterns -fno-warn-incomplete-record-updates #-}++module Main where++import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as TLB+import Spec (spec)+import Test.Syd+import Test.Syd.OptParse+import Text.Colour++main :: IO ()+main = do+  settings <- getSettings+  testForest <- execTestDefM settings spec++  putStrLn "Synchronous, non-interleaved"+  rf1 <- timeItT $ runSpecForestSynchronously settings testForest+  printOutputSpecForest settings rf1++  putStrLn "Synchronous, interleaved"+  _ <- runSpecForestInterleavedWithOutputSynchronously settings testForest++  putStrLn "Asynchronous, non-interleaved"+  rf2 <- timeItT $ runSpecForestAsynchronously settings 8 testForest+  printOutputSpecForest settings rf2++  putStrLn "Asynchronous, interleaved"+  _ <- runSpecForestInterleavedWithOutputAsynchronously settings 8 testForest++  putStrLn "Golden test of output"+  sydTest $+    describe "Golden Output" $+      it "renders output in the same way as before" $+        goldenByteStringFile "test_resources/output-test.txt" $ do+          testForestInOrder <- execTestDefM settings $ doNotRandomiseExecutionOrder spec+          rf <- timeItT $ runSpecForestSynchronously settings testForestInOrder+          let eraseTimed :: Timed a -> Timed a+              eraseTimed t =+                t+                  { timedTime =+                      -- We have to choose zero because it's the identity for addition,+                      -- which is the operation that's used on these times.+                      0+                  }++              erasedTimedInResultForest :: ResultForest -> ResultForest+              erasedTimedInResultForest = fmap (fmap (fmap eraseTimed))+              eraseTiming :: Timed ResultForest -> Timed ResultForest+              eraseTiming = fmap erasedTimedInResultForest . eraseTimed+          pure $+            TE.encodeUtf8+              . LT.toStrict+              . TLB.toLazyText+              . renderResultReport defaultSettings With24BitColours+              $ eraseTiming rf
output-test/Spec.hs view
@@ -3,9 +3,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-missing-methods -fno-warn-partial-fields -fno-warn-incomplete-uni-patterns -fno-warn-incomplete-record-updates #-} -module Main where+module Spec where  import Control.Concurrent+import Control.Concurrent.STM import Control.Exception import Control.Monad import Data.ByteString (ByteString)@@ -14,7 +15,7 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TLB import System.Exit-import System.Random+import System.Random (randomRIO) import Test.QuickCheck import Test.Syd import Test.Syd.OptParse@@ -27,18 +28,6 @@  instance ToUnit Int -- No implementation on purpose -main :: IO ()-main = do-  settings <- getSettings-  testForest <- execTestDefM settings spec-  rf1 <- timeItT $ runSpecForestSynchronously settings testForest-  printOutputSpecForest settings rf1-  _ <- runSpecForestInterleavedWithOutputSynchronously settings testForest-  _ <- runSpecForestInterleavedWithOutputAsynchronously settings 8 testForest-  rf2 <- timeItT $ runSpecForestAsynchronously settings 8 testForest-  printOutputSpecForest settings rf2-  pure ()- spec :: Spec spec = do   it "Passes" (pure () :: IO ())@@ -51,6 +40,11 @@   it "Exit code" $ do     exitWith $ ExitFailure 1 :: IO ()   describe "exceptions" $ do+    let exceptionTest :: String -> a -> Spec+        exceptionTest s a = describe s $ do+          it "fails in IO, as the result" (pure (seq a ()) :: IO ())+          it "fails in IO, as the action" (seq a (pure ()) :: IO ())+          it "fails in pure code" $ seq a True     it "Record construction error" (throw $ RecConError "test" :: IO ())     exceptionTest "Record construction error" $ let c = Cons1 {} in field c     it "Record selection error" (throw $ RecSelError "test" :: IO ())@@ -149,54 +143,56 @@           (LT.toStrict $ TLB.toLazyText $ renderResultReport defaultSettings With24BitColours (Timed [] 0))    doNotRandomiseExecutionOrder $-    describe "Around" $-      do-        describe "before" $ do-          before (() <$ throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+    describe "Around" $ do+      describe "before" $ do+        before (void (throwIO (userError "test"))) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "before_" $ do-          before_ (throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "before_" $ do+        before_ (throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "after" $ do-          after (\_ -> throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "after" $ do+        after (\_ -> throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "after_" $ do-          after_ (throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "after_" $ do+        after_ (throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "around" $ do-          around (\_ -> throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "around" $ do+        around (\_ -> throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "around_" $ do-          around_ (\_ -> throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "around_" $ do+        around_ (\_ -> throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "aroundWith" $ do-          aroundWith (\_ () -> throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "aroundWith" $ do+        aroundWith (\_ () -> throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO () -        describe "aroundWith'" $ do-          aroundWith' (\_ () () -> throwIO (userError "test")) $-            it "does not kill the test suite" $ \() ->-              pure () :: IO ()+      describe "aroundWith'" $ do+        aroundWith' (\_ () () -> throwIO (userError "test")) $+          it "does not kill the test suite" $ \() ->+            pure () :: IO ()+   it "expectationFailure" (expectationFailure "fails" :: IO ())+   describe "String" $ do     it "compares strings" $ ("foo\nbar\tquux " :: String) `shouldBe` "foq\nbaz\tqex"     it "compares strings" $ ("foo\nbar\tquux " :: String) `stringShouldBe` "foq\nbaz\tqex"     it "compares texts" $ ("foo\nbar\tquux " :: Text) `shouldBe` "foq\nbaz\tqex"     it "compares texts" $ ("foo\nbar\tquux " :: Text) `textShouldBe` "foq\nbaz\tqex"     it "compares bytestrings" $ ("foo\nbar\tquux " :: ByteString) `shouldBe` "foq\nbaz\tqex"+   describe "Context" $ do     it "shows a nice context" $ context "Context" $ True `shouldBe` False     it "shows a nice context multiple levels deep" $@@ -219,7 +215,7 @@                   property $ \m ->                     i + j + k + l + m `shouldBe` m + l + k + j + i + (1 :: Int)       let magnitude :: Int -> Int-          magnitude = (ceiling :: Double -> Int) . logBase 10 . fromIntegral+          magnitude = max 0 . (ceiling :: Double -> Int) . logBase 10 . fromIntegral       describe "labels" $ do         it "shows the labels in use on success" $           property $ \xs ->@@ -235,6 +231,7 @@             label ("length of input is " ++ show (length xs)) $               label ("magnitude (digits) of sum of input is " ++ show (magnitude (sum xs))) $                 reverse (reverse xs) `shouldBe` (0 : xs :: [Int])+       describe "classes" $ do         it "shows the classes in use on success" $           forAll (sort <$> arbitrary) $ \xs ->@@ -252,16 +249,13 @@               classify (length xs == 1) "single element" $                 classify (length xs > 1) "non-trivial" $                   sort xs `shouldBe` (0 : xs :: [Int])+       describe "tables" $ do         it "shows the tables in use on success" $           forAll (sort <$> arbitrary) $ \xs ->             tabulate "List elements" (map show xs) $               sort xs `shouldBe` (xs :: [Int])-        it "shows the tables in use on success" $-          forAll (sort <$> arbitrary) $ \xs ->-            tabulate "List elements" (map show xs) $-              tabulate "List magnitudes" (map (show . magnitude) xs) $-                sort xs `shouldBe` (xs :: [Int])+   modifyMaxSize (const 30) $ -- Bigger than the 20 below     modifyMaxShrinks (const 30) $ -- Definitely not zero       describe "Shrinking" $ do@@ -276,18 +270,81 @@             forAllShrink (sized $ \n -> pure n) shrink $ \i -> do               () <- readMVar var               i `shouldSatisfy` (< 20)++  describe "Retries" $ do+    withoutRetries $+      it "does not retry if the test is configured withoutRetries" False+    withRetries 5 $+      it "Retries this five times" False+   describe "Flakiness" $ do-    notFlaky $ it "does not retry if not allowed" False-    flaky 3 $ do-      it "can retry booleans" False-      notFlaky $ it "does not retry booleans that have been explicitly marked as 'notFlaky'" False-    flakyWith 100 "We're on it!" $-      it "can retry randomness" $ do-        i <- randomRIO (1, 10)-        i `shouldBe` (1 :: Int)+    potentiallyFlaky $ do+      it "Allows flakiness on True eventhough there is none (should succeed)" True+      it "Allows flakiness on False eventhough there is none (should fail)" False+    potentiallyFlakyWith "We're on it!" $ do+      var <- liftIO $ newTVarIO (0 :: Int)+      it "allows this intentionally flaky test with the default number of retries" $ do+        atomically $ modifyTVar' var succ+        i <- readTVarIO var+        i `shouldBe` 2+    notFlaky $ do+      var <- liftIO $ newTVarIO (0 :: Int)+      it "Does not allow flakiness if flakiness is not allowed even if retries happen" $ do+        atomically $ modifyTVar' var succ+        i <- readTVarIO var+        i `shouldBe` 2+    flaky 5 $ it "Allows flakiness in this boolean five times (should fail with 5 retries)" False+    flakyWith 4 "We're on it!" $ do+      var <- liftIO $ newTVarIO (0 :: Int)+      it "allows this intentionally flaky test with up to four retries" $ do+        atomically $ modifyTVar' var succ+        i <- readTVarIO var+        i `shouldBe` 2 -exceptionTest :: String -> a -> Spec-exceptionTest s a = describe s $ do-  it "fails in IO, as the result" (pure (seq a ()) :: IO ())-  it "fails in IO, as the action" (seq a (pure ()) :: IO ())-  it "fails in pure code" $ seq a True+  describe "xdescribe" $ do+    xdescribe "two pending tests below here" $ do+      it "one" False+      it "two" True+    xdescribe "four pending tests below here" $ do+      it "one" False+      it "two" True+      describe "wat" $ do+        it "three" False+        it "four" True++  describe "callstack" $ do+    it "it" False+    specify "specify" False+    prop "prop" False+    describe "describe" $ do+      it "describe-it" False+      specify "describe-specify" False++  describe "expectations" $ do+    expectFailing $ do+      it "considered passing" False+      expectPassing $ it "considered passing" True+    expectPassing $ do+      it "considered failing" False+      expectFailing $ it "considered failing" True++  describe "combinators" $ do+    let somePropertyCombinator :: Gen Int -> (Int -> Int) -> Property+        somePropertyCombinator gen func =+          forAll gen $ \i ->+            even (func i)+    it "should fail" $ somePropertyCombinator arbitrary (* 3)+    it "should pass" $ somePropertyCombinator arbitrary (* 4)+    it "should not crash (undefined value)" $ somePropertyCombinator arbitrary undefined+    it "should not crash (undefined generator)" $ somePropertyCombinator undefined (* 2)++    let someTestSuiteCombinator i =+          it "should be even" $ even (i :: Int)+    someTestSuiteCombinator 1+    someTestSuiteCombinator 2+    someTestSuiteCombinator undefined++  describe "randomness" $+    it "always outputs the same pseudorandomness" $ do+      i <- randomRIO (1, 100)+      i `shouldBe` (2 :: Int)
src/Test/Syd.hs view
@@ -179,6 +179,26 @@     withExecutionOrderRandomisation,     ExecutionOrderRandomisation (..), +    -- *** Modifying the number of retries+    modifyRetries,+    withoutRetries,+    withRetries,++    -- *** Declaring flakiness+    flaky,+    flakyWith,+    notFlaky,+    potentiallyFlaky,+    potentiallyFlakyWith,+    withFlakiness,+    FlakinessMode (..),++    -- *** Declaring expectations+    expectPassing,+    expectFailing,+    withExpectationMode,+    ExpectationMode (..),+     -- *** Doing IO during test definition     runIO, @@ -210,6 +230,7 @@      -- * Utilities     ppShow,+    pPrint,      -- * Reexports     module Test.Syd.Def,@@ -239,7 +260,7 @@ import Test.Syd.Runner import Test.Syd.SpecDef import Test.Syd.SpecForest-import Text.Show.Pretty (ppShow)+import Text.Show.Pretty (pPrint, ppShow)  -- | Evaluate a test suite definition and then run it. --
src/Test/Syd/Def/Around.hs view
@@ -214,7 +214,9 @@               DefAfterAllNode f sdf -> DefAfterAllNode f $ modifyForest sdf               DefParallelismNode f sdf -> DefParallelismNode f $ modifyForest sdf               DefRandomisationNode f sdf -> DefRandomisationNode f $ modifyForest sdf+              DefRetriesNode f sdf -> DefRetriesNode f $ modifyForest sdf               DefFlakinessNode f sdf -> DefFlakinessNode f $ modifyForest sdf+              DefExpectationNode f sdf -> DefExpectationNode f $ modifyForest sdf             modifyForest ::               forall x extra.               HContains x outer =>
src/Test/Syd/Def/Specify.hs view
@@ -70,9 +70,8 @@    in local (\tde -> tde {testDefEnvDescriptionPath = t : testDefEnvDescriptionPath tde})         . censor ((: []) . DefDescribeNode t) --- TODO maybe we want to keep all tests below but replace them with a "Pending" instead. xdescribe :: String -> TestDefM outers inner () -> TestDefM outers inner ()-xdescribe s _ = pending s+xdescribe s = describe s . censor (markSpecForestAsPending Nothing)  -- | Declare a test --@@ -171,7 +170,7 @@   -- | The test itself   test ->   TestDefM outers inner ()-it s t = do+it s t = withFrozenCallStack $ do   sets <- asks testDefEnvTestRunSettings   let testDef =         TDef@@ -205,7 +204,7 @@   -- | The test itself   test ->   TestDefM outers inner ()-specify = it+specify s t = withFrozenCallStack $ it s t  -- | A synonym for 'xit' xspecify ::@@ -273,7 +272,7 @@   -- The test itself   test ->   TestDefM (outer ': otherOuters) inner ()-itWithOuter s t = do+itWithOuter s t = withFrozenCallStack $ do   sets <- asks testDefEnvTestRunSettings   let testDef =         TDef@@ -304,7 +303,7 @@   -- The test itself   test ->   TestDefM (outer ': otherOuters) inner ()-specifyWithOuter = itWithOuter+specifyWithOuter s t = withFrozenCallStack $ itWithOuter s t  -- | A synonym for 'xitWithOuter' xspecifyWithOuter ::@@ -372,7 +371,7 @@   String ->   test ->   TestDefM (outer ': otherOuters) inner ()-itWithBoth s t = do+itWithBoth s t = withFrozenCallStack $ do   sets <- asks testDefEnvTestRunSettings   let testDef =         TDef@@ -407,7 +406,7 @@   String ->   test ->   TestDefM (outer ': otherOuters) inner ()-specifyWithBoth = itWithBoth+specifyWithBoth s t = withFrozenCallStack $ itWithBoth s t  -- | A synonym for 'xitWithBoth' xspecifyWithBoth ::@@ -441,7 +440,7 @@   String ->   test ->   TestDefM outers inner ()-itWithAll s t = do+itWithAll s t = withFrozenCallStack $ do   sets <- asks testDefEnvTestRunSettings   let testDef =         TDef@@ -476,7 +475,7 @@   String ->   test ->   TestDefM outers inner ()-specifyWithAll = itWithAll+specifyWithAll s t = withFrozenCallStack $ itWithAll s t  -- | A synonym for 'xitWithAll' xspecifyWithAll ::@@ -494,7 +493,7 @@ -- -- > prop s p = it s $ property p prop :: Testable prop => String -> prop -> Spec-prop s p = it s $ property p+prop s p = withFrozenCallStack $ it s $ property p  -- | Declare a test that has not been written yet. pending :: String -> TestDefM outers inner ()
src/Test/Syd/Modify.hs view
@@ -23,12 +23,25 @@     withExecutionOrderRandomisation,     ExecutionOrderRandomisation (..), +    -- * Modifying the number of retries+    modifyRetries,+    withoutRetries,+    withRetries,+     -- * Declaring flakiness     flaky,     flakyWith,     notFlaky,+    potentiallyFlaky,+    potentiallyFlakyWith,     withFlakiness,     FlakinessMode (..),++    -- * Declaring expectations+    expectPassing,+    expectFailing,+    withExpectationMode,+    ExpectationMode (..),   ) where @@ -77,7 +90,19 @@ withExecutionOrderRandomisation :: ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c withExecutionOrderRandomisation p = censor ((: []) . DefRandomisationNode p) --- | Mark a test suite as "potentially flaky".+-- | Modify the number of retries to use in flakiness diagnostics.+modifyRetries :: (Word -> Word) -> TestDefM a b c -> TestDefM a b c+modifyRetries modRetries = censor ((: []) . DefRetriesNode modRetries)++-- | Turn off retries+withoutRetries :: TestDefM a b c -> TestDefM a b c+withoutRetries = modifyRetries (const 0)++-- | Make the number of retries this constant+withRetries :: Word -> TestDefM a b c -> TestDefM a b c+withRetries w = modifyRetries (const w)++-- | Mark a test suite as "potentially flaky" with a given number of retries. -- -- This will retry any test in the given test group up to the given number of tries, and pass a test if it passes once. -- The test output will show which tests were flaky.@@ -86,16 +111,16 @@ -- In other words: tests using flaky must be guaranteed to fail every time if -- an error is introduced in the code, it should only be added to deal with -- accidental failures, never accidental passes.-flaky :: Int -> TestDefM a b c -> TestDefM a b c-flaky i = withFlakiness $ MayBeFlakyUpTo i Nothing+flaky :: Word -> TestDefM a b c -> TestDefM a b c+flaky i = withRetries i . withFlakiness (MayBeFlaky Nothing)  -- | Like 'flaky', but also shows the given message to the user whenever the test is flaky. -- -- You could use it like this: -- -- >>> flakyWith 3 "Something sometimes goes wrong with the database, see issue 6346" ourTestSuite-flakyWith :: Int -> String -> TestDefM a b c -> TestDefM a b c-flakyWith i message = withFlakiness $ MayBeFlakyUpTo i (Just message)+flakyWith :: Word -> String -> TestDefM a b c -> TestDefM a b c+flakyWith i message = modifyRetries (const i) . withFlakiness (MayBeFlaky (Just message))  -- | Mark a test suite as "must not be flaky". --@@ -103,6 +128,27 @@ notFlaky :: TestDefM a b c -> TestDefM a b c notFlaky = withFlakiness MayNotBeFlaky +-- | Mark a test suite as 'potentially flaky', such that it will not fail if it is+-- flaky but passes at least once.+potentiallyFlaky :: TestDefM a b c -> TestDefM a b c+potentiallyFlaky = withFlakiness (MayBeFlaky Nothing)++-- | Like 'potentiallyFlaky', but with a message.+potentiallyFlakyWith :: String -> TestDefM a b c -> TestDefM a b c+potentiallyFlakyWith message = withFlakiness (MayBeFlaky (Just message))+ -- | Annotate a test group with 'FlakinessMode'. withFlakiness :: FlakinessMode -> TestDefM a b c -> TestDefM a b c withFlakiness f = censor ((: []) . DefFlakinessNode f)++-- | Mark a test suite as 'should pass'+expectPassing :: TestDefM a b c -> TestDefM a b c+expectPassing = withExpectationMode ExpectPassing++-- | Mark a test suite as 'should fail'+expectFailing :: TestDefM a b c -> TestDefM a b c+expectFailing = withExpectationMode ExpectFailing++-- | Annotate a test suite with 'ExpectationMode'+withExpectationMode :: ExpectationMode -> TestDefM a b c -> TestDefM a b c+withExpectationMode em = censor ((: []) . DefExpectationNode em)
src/Test/Syd/OptParse.hs view
@@ -65,8 +65,10 @@     -- | Whether to stop upon the first test failure     settingFailFast :: !Bool,     -- | How many iterations to use to look diagnose flakiness-    settingIterations :: Iterations,-    -- | Whether to fail when any flakiness is detected+    settingIterations :: !Iterations,+    -- | How many times to retry a test for flakiness diagnostics+    settingRetries :: !Word,+    -- | Whether to fail when any flakiness is detected in tests declared as flaky     settingFailOnFlaky :: !Bool,     -- | How to report progress     settingReportProgress :: !ReportProgress,@@ -92,11 +94,15 @@           settingFilter = Nothing,           settingFailFast = False,           settingIterations = OneIteration,+          settingRetries = defaultRetries,           settingFailOnFlaky = False,           settingReportProgress = ReportNoProgress,           settingDebug = False         } +defaultRetries :: Word+defaultRetries = 3+ deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities deriveTerminalCapababilities settings = case settingColour settings of   Just False -> pure WithoutColours@@ -186,6 +192,7 @@             (if debugMode then True else d settingFailFast)             (flagFailFast <|> envFailFast <|> mc configFailFast),         settingIterations = fromMaybe (d settingIterations) $ flagIterations <|> envIterations <|> mc configIterations,+        settingRetries = fromMaybe (d settingRetries) $ flagRetries <|> envRetries <|> mc configRetries,         settingFailOnFlaky = fromMaybe (d settingFailOnFlaky) $ flagFailOnFlaky <|> envFailOnFlaky <|> mc configFailOnFlaky,         settingReportProgress = setReportProgress,         settingDebug = debugMode@@ -214,6 +221,7 @@     configFilter :: !(Maybe Text),     configFailFast :: !(Maybe Bool),     configIterations :: !(Maybe Iterations),+    configRetries :: !(Maybe Word),     configFailOnFlaky :: !(Maybe Bool),     configReportProgress :: !(Maybe Bool),     configDebug :: !(Maybe Bool)@@ -244,7 +252,8 @@         <*> optionalField "filter" "Filter to select which parts of the test tree to run" .= configFilter         <*> optionalField "fail-fast" "Whether to stop executing upon the first test failure" .= configFailFast         <*> optionalField "iterations" "How many iterations to use to look diagnose flakiness" .= configIterations-        <*> optionalField "fail-on-flaky" "Whether to fail when any flakiness is detected" .= configFailOnFlaky+        <*> optionalField "retries" "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'" .= configRetries+        <*> optionalField "fail-on-flaky" "Whether to fail when any flakiness is detected in tests marked as potentially flaky" .= configFailOnFlaky         <*> optionalField "progress" "How to report progres" .= configReportProgress         <*> optionalField "debug" "Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true" .= configDebug @@ -308,6 +317,7 @@     envFilter :: !(Maybe Text),     envFailFast :: !(Maybe Bool),     envIterations :: !(Maybe Iterations),+    envRetries :: !(Maybe Word),     envFailOnFlaky :: !(Maybe Bool),     envReportProgress :: !(Maybe Bool),     envDebug :: !(Maybe Bool)@@ -331,6 +341,7 @@       envFilter = Nothing,       envFailFast = Nothing,       envIterations = Nothing,+      envRetries = Nothing,       envFailOnFlaky = Nothing,       envReportProgress = Nothing,       envDebug = Nothing@@ -362,7 +373,8 @@         <*> Env.var (fmap Just . Env.str) "FILTER" (Env.def Nothing <> Env.help "Filter to select which parts of the test tree to run")         <*> Env.var (fmap Just . Env.auto) "FAIL_FAST" (Env.def Nothing <> Env.help "Whether to stop executing upon the first test failure")         <*> Env.var (fmap Just . (Env.auto >=> parseIterations)) "ITERATIONS" (Env.def Nothing <> Env.help "How many iterations to use to look diagnose flakiness")-        <*> Env.var (fmap Just . Env.auto) "FAIL_ON_FLAKY" (Env.def Nothing <> Env.help "Whether to fail when flakiness is detected")+        <*> Env.var (fmap Just . Env.auto) "RETRIES" (Env.def Nothing <> Env.help "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'")+        <*> Env.var (fmap Just . Env.auto) "FAIL_ON_FLAKY" (Env.def Nothing <> Env.help "Whether to fail when flakiness is detected in tests marked as potentially flaky")         <*> Env.var (fmap Just . Env.auto) "PROGRESS" (Env.def Nothing <> Env.help "Report progress as tests run")         <*> Env.var (fmap Just . Env.auto) "DEBUG" (Env.def Nothing <> Env.help "Turn on debug mode. This implies RANDOMISE_EXECUTION_ORDER=False, PARALLELISM=1 and FAIL_FAST=True.")   where@@ -428,6 +440,7 @@     flagFilter :: !(Maybe Text),     flagFailFast :: !(Maybe Bool),     flagIterations :: !(Maybe Iterations),+    flagRetries :: !(Maybe Word),     flagFailOnFlaky :: !(Maybe Bool),     flagReportProgress :: !(Maybe Bool),     flagDebug :: !(Maybe Bool)@@ -451,6 +464,7 @@       flagFilter = Nothing,       flagFailFast = Nothing,       flagIterations = Nothing,+      flagRetries = Nothing,       flagFailOnFlaky = Nothing,       flagReportProgress = Nothing,       flagDebug = Nothing@@ -584,6 +598,15 @@                 ]             )       )+    <*> optional+      ( option+          auto+          ( mconcat+              [ long "retries",+                help "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'"+              ]+          )+      )     <*> doubleSwitch ["fail-on-flaky"] (help "Fail when any flakiness is detected")     <*> doubleSwitch ["progress"] (help "Report progress")     <*> doubleSwitch ["debug"] (help "Turn on debug mode. This implies --no-randomise-execution-order, --synchronous, --progress and --fail-fast.")@@ -612,6 +635,6 @@ doubleSwitch :: [String] -> OptParse.Mod FlagFields (Maybe Bool) -> OptParse.Parser (Maybe Bool) doubleSwitch suffixes mods =   flag' (Just True) (hidden <> internal <> foldMap long suffixes <> mods)-    <|> flag' (Just False) (hidden <> internal <> foldMap long suffixes <> mods)+    <|> flag' (Just False) (hidden <> internal <> foldMap (long . ("no-" <>)) suffixes <> mods)     <|> flag' Nothing (foldMap (\suffix -> long ("[no-]" <> suffix)) suffixes <> mods)     <|> pure Nothing
src/Test/Syd/Output.hs view
@@ -44,13 +44,13 @@ outputResultReport settings trf@(Timed rf _) =   concat     [ outputTestsHeader,-      outputSpecForest 0 (resultForestWidth rf) rf,+      outputSpecForest settings 0 (resultForestWidth rf) rf,       [ [chunk ""],         [chunk ""]       ],       outputFailuresWithHeading settings rf,       [[chunk ""]],-      outputStats (computeTestSuiteStats <$> trf),+      outputStats (computeTestSuiteStats settings <$> trf),       [[chunk ""]]     ] @@ -144,34 +144,36 @@     [chunk ""]   ] -outputSpecForest :: Int -> Int -> ResultForest -> [[Chunk]]-outputSpecForest level treeWidth = concatMap (outputSpecTree level treeWidth)+outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]+outputSpecForest settings level treeWidth = concatMap (outputSpecTree settings level treeWidth) -outputSpecTree :: Int -> Int -> ResultTree -> [[Chunk]]-outputSpecTree level treeWidth = \case-  SpecifyNode t td -> outputSpecifyLines level treeWidth t td+outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]+outputSpecTree settings level treeWidth = \case+  SpecifyNode t td -> outputSpecifyLines settings level treeWidth t td   PendingNode t mr -> outputPendingLines t mr-  DescribeNode t sf -> outputDescribeLine t : map (padding :) (outputSpecForest (level + 1) treeWidth sf)-  SubForestNode sf -> outputSpecForest level treeWidth sf+  DescribeNode t sf -> outputDescribeLine t : map (padding :) (outputSpecForest settings (level + 1) treeWidth sf)+  SubForestNode sf -> outputSpecForest settings level treeWidth sf  outputDescribeLine :: Text -> [Chunk] outputDescribeLine t = [fore yellow $ chunk t] -outputSpecifyLines :: Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]-outputSpecifyLines level treeWidth specifyText (TDef (Timed TestRunResult {..} executionTime) _) =-  let withStatusColour = fore (statusColour testRunResultStatus)+outputSpecifyLines :: Settings -> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]+outputSpecifyLines settings level treeWidth specifyText (TDef (Timed testRunReport executionTime) _) =+  let status = testRunReportStatus settings testRunReport+      TestRunResult {..} = testRunReportReportedRun testRunReport+      withStatusColour = fore (statusColour status)       pad = (chunk (T.pack (replicate paddingSize ' ')) :)       timeChunk = timeChunkFor executionTime    in filter         (not . null)         $ concat-          [ [ [ withStatusColour $ chunk (statusCheckMark testRunResultStatus),+          [ [ [ withStatusColour $ chunk (statusCheckMark status),                 withStatusColour $ chunk specifyText,                 spacingChunk level specifyText (chunkText timeChunk) treeWidth,                 timeChunk               ]             ],-            map pad $ retriesChunks testRunResultStatus testRunResultRetries testRunResultFlakinessMessage,+            map pad $ retriesChunks testRunReport,             [ pad                 [ chunk "passed for all of ",                   case w of@@ -179,7 +181,7 @@                     _ -> fore green $ chunk (T.pack (printf "%d" w)),                   " inputs."                 ]-              | testRunResultStatus == TestPassed,+              | status == TestPassed,                 w <- maybeToList testRunResultNumTests             ],             map pad $ labelsChunks (fromMaybe 1 testRunResultNumTests) testRunResultLabels,@@ -203,21 +205,27 @@         if             | t < 10 -> fore green             | t < 100 -> fore yellow-            | t < 1000 -> fore orange-            | t < 10000 -> fore red+            | t < 1_000 -> fore orange+            | t < 10_000 -> fore red             | otherwise -> fore darkRed    in withTimingColour $ chunk executionTimeText -retriesChunks :: TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]-retriesChunks status mRetries mMessage = case mRetries of-  Nothing -> []-  Just retries -> case status of-    TestPassed ->-      concat-        [ [["Retries: ", chunk (T.pack (show retries)), fore red " !!! FLAKY !!!"]],-          [[fore magenta $ chunk $ T.pack message] | message <- maybeToList mMessage]-        ]-    TestFailed -> [["Retries: ", chunk (T.pack (show retries)), " (likely not flaky)"]]+retriesChunks :: TestRunReport -> [[Chunk]]+retriesChunks testRunReport =+  case testRunReportRetries testRunReport of+    Nothing -> []+    Just retries ->+      let flaky = testRunReportWasFlaky testRunReport+          mMessage = case testRunReportFlakinessMode testRunReport of+            MayBeFlaky mmesg -> mmesg+            MayNotBeFlaky -> Nothing+       in if flaky+            then+              concat+                [ [["Retries: ", chunk (T.pack (show retries)), fore red " !!! FLAKY !!!"]],+                  [[fore magenta $ chunk $ T.pack message] | message <- maybeToList mMessage]+                ]+            else [["Retries: ", chunk (T.pack (show retries)), " (likely not flaky)"]]  labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]] labelsChunks _ Nothing = []@@ -225,22 +233,22 @@   | M.null labels = []   | map fst (M.toList labels) == [[]] = []   | otherwise =-      [chunk "Labels"] :-      map-        ( pad-            . ( \(ss, i) ->-                  [ chunk-                      ( T.pack-                          ( printf-                              "%5.2f%% %s"-                              (100 * fromIntegral i / fromIntegral totalCount :: Double)-                              (commaList (map show ss))-                          )-                      )-                  ]-              )-        )-        (M.toList labels)+    [chunk "Labels"] :+    map+      ( pad+          . ( \(ss, i) ->+                [ chunk+                    ( T.pack+                        ( printf+                            "%5.2f%% %s"+                            (100 * fromIntegral i / fromIntegral totalCount :: Double)+                            (commaList (map show ss))+                        )+                    )+                ]+            )+      )+      (M.toList labels)   where     pad = (chunk (T.pack (replicate paddingSize ' ')) :) @@ -249,19 +257,19 @@ classesChunks (Just classes)   | M.null classes = []   | otherwise =-      [chunk "Classes"] :-      map-        ( pad-            . ( \(s, i) ->-                  [ chunk-                      ( T.pack-                          ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) s-                          )-                      )-                  ]-              )-        )-        (M.toList classes)+    [chunk "Classes"] :+    map+      ( pad+          . ( \(s, i) ->+                [ chunk+                    ( T.pack+                        ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) s+                        )+                    )+                ]+            )+      )+      (M.toList classes)   where     pad = (chunk (T.pack (replicate paddingSize ' ')) :)     total = sum $ map snd $ M.toList classes@@ -341,50 +349,52 @@  outputFailures :: Settings -> ResultForest -> [[Chunk]] outputFailures settings rf =-  let failures = filter (testFailed settings . timedValue . testDefVal . snd) $ flattenSpecForest rf+  let failures = filter (testRunReportFailed settings . timedValue . testDefVal . snd) $ flattenSpecForest rf       nbDigitsInFailureCount :: Int       nbDigitsInFailureCount = floor (logBase 10 (L.genericLength failures) :: Double)       padFailureDetails = (chunk (T.pack (replicate (nbDigitsInFailureCount + 4) ' ')) :)    in map (padding :) $         filter (not . null) $           concat $-            indexed failures $ \w (ts, TDef (Timed TestRunResult {..} _) cs) ->-              concat-                [ [ [ fore cyan $-                        chunk $-                          T.pack $-                            replicate 2 ' '-                              ++ case headMay $ getCallStack cs of-                                Nothing -> "Unknown location"-                                Just (_, SrcLoc {..}) ->-                                  concat-                                    [ srcLocFile,-                                      ":",-                                      show srcLocStartLine-                                    ]-                    ],-                    map-                      (fore (statusColour testRunResultStatus))-                      [ chunk $ statusCheckMark testRunResultStatus,-                        chunk $ T.pack (printf ("%" ++ show nbDigitsInFailureCount ++ "d ") w),-                        chunk $ T.intercalate "." ts-                      ]-                  ],-                  map padFailureDetails $ retriesChunks testRunResultStatus testRunResultRetries testRunResultFlakinessMessage,-                  map (padFailureDetails . (: []) . chunk . T.pack) $-                    case (testRunResultNumTests, testRunResultNumShrinks) of-                      (Nothing, _) -> []-                      (Just numTests, Nothing) -> [printf "Failed after %d tests" numTests]-                      (Just numTests, Just 0) -> [printf "Failed after %d tests" numTests]-                      (Just numTests, Just numShrinks) -> [printf "Failed after %d tests and %d shrinks" numTests numShrinks],-                  map (padFailureDetails . (\c -> [chunk "Generated: ", c]) . fore yellow . chunk . T.pack) testRunResultFailingInputs,-                  map padFailureDetails $ outputFailureLabels testRunResultLabels,-                  map padFailureDetails $ outputFailureClasses testRunResultClasses,-                  map padFailureDetails $ maybe [] outputSomeException testRunResultException,-                  [padFailureDetails $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase],-                  concat [map padFailureDetails $ stringChunks ei | ei <- maybeToList testRunResultExtraInfo],-                  [[chunk ""]]-                ]+            indexed failures $ \w (ts, TDef (Timed testRunReport _) cs) ->+              let status = testRunReportStatus settings testRunReport+                  TestRunResult {..} = testRunReportReportedRun testRunReport+               in concat+                    [ [ [ fore cyan $+                            chunk $+                              T.pack $+                                replicate 2 ' '+                                  ++ case headMay $ getCallStack cs of+                                    Nothing -> "Unknown location"+                                    Just (_, SrcLoc {..}) ->+                                      concat+                                        [ srcLocFile,+                                          ":",+                                          show srcLocStartLine+                                        ]+                        ],+                        map+                          (fore (statusColour status))+                          [ chunk $ statusCheckMark status,+                            chunk $ T.pack (printf ("%" ++ show nbDigitsInFailureCount ++ "d ") w),+                            chunk $ T.intercalate "." ts+                          ]+                      ],+                      map padFailureDetails $ retriesChunks testRunReport,+                      map (padFailureDetails . (: []) . chunk . T.pack) $+                        case (testRunResultNumTests, testRunResultNumShrinks) of+                          (Nothing, _) -> []+                          (Just numTests, Nothing) -> [printf "Failed after %d tests" numTests]+                          (Just numTests, Just 0) -> [printf "Failed after %d tests" numTests]+                          (Just numTests, Just numShrinks) -> [printf "Failed after %d tests and %d shrinks" numTests numShrinks],+                      map (padFailureDetails . (\c -> [chunk "Generated: ", c]) . fore yellow . chunk . T.pack) testRunResultFailingInputs,+                      map padFailureDetails $ outputFailureLabels testRunResultLabels,+                      map padFailureDetails $ outputFailureClasses testRunResultClasses,+                      map padFailureDetails $ maybe [] outputSomeException testRunResultException,+                      [padFailureDetails $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase],+                      concat [map padFailureDetails $ stringChunks ei | ei <- maybeToList testRunResultExtraInfo],+                      [[chunk ""]]+                    ]  outputSomeException :: SomeException -> [[Chunk]] outputSomeException outerException =@@ -485,11 +495,6 @@ indexed :: [a] -> (Word -> a -> b) -> [b] indexed ls func = zipWith func [1 ..] ls -outputFailure :: TestRunResult -> Maybe [[Chunk]]-outputFailure TestRunResult {..} = case testRunResultStatus of-  TestPassed -> Nothing-  TestFailed -> Just [[chunk "Failure"]]- statusColour :: TestStatus -> Colour statusColour = \case   TestPassed -> green@@ -530,8 +535,10 @@       DefAroundAllWithNode _ sdf -> goF level sdf       DefAfterAllNode _ sdf -> goF level sdf       DefParallelismNode _ sdf -> goF level sdf+      DefRetriesNode _ sdf -> goF level sdf       DefRandomisationNode _ sdf -> goF level sdf       DefFlakinessNode _ sdf -> goF level sdf+      DefExpectationNode _ sdf -> goF level sdf  padding :: Chunk padding = chunk $ T.replicate paddingSize " "
src/Test/Syd/Run.hs view
@@ -73,7 +73,6 @@ runPureTestWithArg computeBool TestRunSettings {} progressReporter wrapper = do   let report = reportProgress progressReporter   let testRunResultNumTests = Nothing-  let testRunResultRetries = Nothing   report ProgressTestStarting   resultBool <-     applyWrapper2 wrapper $@@ -89,7 +88,6 @@   let testRunResultLabels = Nothing   let testRunResultClasses = Nothing   let testRunResultTables = Nothing-  let testRunResultFlakinessMessage = Nothing   pure TestRunResult {..}  applyWrapper2 ::@@ -143,7 +141,6 @@   let report = reportProgress progressReporter    let testRunResultNumTests = Nothing-  let testRunResultRetries = Nothing    report ProgressTestStarting   result <- liftIO $@@ -162,7 +159,6 @@   let testRunResultLabels = Nothing   let testRunResultClasses = Nothing   let testRunResultTables = Nothing-  let testRunResultFlakinessMessage = Nothing   pure TestRunResult {..}  instance IsTest Property where@@ -221,8 +217,6 @@    let testRunResultGoldenCase = Nothing   let testRunResultNumTests = Just $ fromIntegral $ numTests qcr-  let testRunResultRetries = Nothing-  let testRunResultFlakinessMessage = Nothing   case qcr of     Success {} -> do       let testRunResultStatus = TestPassed@@ -366,7 +360,6 @@   let (testRunResultStatus, testRunResultGoldenCase, testRunResultException) = case errOrTrip of         Left e -> (TestFailed, Nothing, Just e)         Right trip -> trip-  let testRunResultRetries = Nothing   let testRunResultNumTests = Nothing   let testRunResultNumShrinks = Nothing   let testRunResultFailingInputs = []@@ -374,7 +367,6 @@   let testRunResultLabels = Nothing   let testRunResultClasses = Nothing   let testRunResultTables = Nothing-  let testRunResultFlakinessMessage = Nothing   pure TestRunResult {..}  exceptionHandlers :: [Handler (Either SomeException a)]@@ -427,7 +419,6 @@  data TestRunResult = TestRunResult   { testRunResultStatus :: !TestStatus,-    testRunResultRetries :: !(Maybe Int),     testRunResultException :: !(Maybe SomeException),     testRunResultNumTests :: !(Maybe Word),     testRunResultNumShrinks :: !(Maybe Word),@@ -436,8 +427,7 @@     testRunResultClasses :: !(Maybe (Map String Int)),     testRunResultTables :: !(Maybe (Map String (Map String Int))),     testRunResultGoldenCase :: !(Maybe GoldenCase),-    testRunResultExtraInfo :: !(Maybe String),-    testRunResultFlakinessMessage :: !(Maybe String)+    testRunResultExtraInfo :: !(Maybe String)   }   deriving (Show, Generic) 
src/Test/Syd/Runner.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}@@ -18,6 +19,7 @@ import qualified Data.Text.IO as TIO import System.Environment import System.Mem (performGC)+import System.Random (mkStdGen, setStdGen) import Test.Syd.Def import Test.Syd.OptParse import Test.Syd.Output@@ -42,28 +44,30 @@ sydTestOnce settings spec = do   specForest <- execTestDefM settings spec   tc <- deriveTerminalCapababilities settings-  withArgs [] $ case settingThreads settings of-    Synchronous -> runSpecForestInterleavedWithOutputSynchronously settings specForest-    ByCapabilities -> do-      i <- fromIntegral <$> getNumCapabilities+  withArgs [] $ do+    setPseudorandomness (settingSeed settings)+    case settingThreads settings of+      Synchronous -> runSpecForestInterleavedWithOutputSynchronously settings specForest+      ByCapabilities -> do+        i <- fromIntegral <$> getNumCapabilities -      when (i == 1) $ do-        let outputLine :: [Chunk] -> IO ()-            outputLine lineChunks = liftIO $ do-              putChunksLocaleWith tc lineChunks-              TIO.putStrLn ""-        mapM_-          ( outputLine-              . (: [])-              . fore red-          )-          [ chunk "WARNING: Only one CPU core detected, make sure to compile your test suite with these ghc options:",-            chunk "         -threaded -rtsopts -with-rtsopts=-N",-            chunk "         (This is important for correctness as well as speed, as a parallell test suite can find thread safety problems.)"-          ]-      runSpecForestInterleavedWithOutputAsynchronously settings i specForest-    Asynchronous i ->-      runSpecForestInterleavedWithOutputAsynchronously settings i specForest+        when (i == 1) $ do+          let outputLine :: [Chunk] -> IO ()+              outputLine lineChunks = liftIO $ do+                putChunksLocaleWith tc lineChunks+                TIO.putStrLn ""+          mapM_+            ( outputLine+                . (: [])+                . fore red+            )+            [ chunk "WARNING: Only one CPU core detected, make sure to compile your test suite with these ghc options:",+              chunk "         -threaded -rtsopts -with-rtsopts=-N",+              chunk "         (This is important for correctness as well as speed, as a parallell test suite can find thread safety problems.)"+            ]+        runSpecForestInterleavedWithOutputAsynchronously settings i specForest+      Asynchronous i ->+        runSpecForestInterleavedWithOutputAsynchronously settings i specForest  sydTestIterations :: Maybe Word -> Settings -> TestDefM '[] () r -> IO (Timed ResultForest) sydTestIterations totalIterations settings spec =@@ -71,6 +75,7 @@     nbCapabilities <- fromIntegral <$> getNumCapabilities      let runOnce settings_ = do+          setPseudorandomness (settingSeed settings_)           specForest <- execTestDefM settings_ spec           r <- timeItT $ case settingThreads settings_ of             Synchronous -> runSpecForestSynchronously settings_ specForest@@ -100,3 +105,8 @@     rf <- go 0     printOutputSpecForest settings rf     pure rf++setPseudorandomness :: SeedSetting -> IO ()+setPseudorandomness = \case+  RandomSeed -> pure ()+  FixedSeed seed -> setStdGen (mkStdGen seed)
src/Test/Syd/Runner/Asynchronous.hs view
@@ -2,17 +2,21 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}  -- | This module defines how to run a test suite-module Test.Syd.Runner.Asynchronous where+module Test.Syd.Runner.Asynchronous+  ( runSpecForestAsynchronously,+    runSpecForestInterleavedWithOutputAsynchronously,+  )+where  import Control.Concurrent-import Control.Concurrent.Async+import Control.Concurrent.Async as Async import Control.Exception import Control.Monad.Reader-import Data.IORef import Data.Maybe import Data.Set (Set) import qualified Data.Set as S@@ -23,7 +27,7 @@ import Test.Syd.OptParse import Test.Syd.Output import Test.Syd.Run-import Test.Syd.Runner.Synchronous+import Test.Syd.Runner.Single import Test.Syd.SpecDef import Test.Syd.SpecForest import Text.Colour@@ -46,9 +50,9 @@   ((), resultForest) <- concurrently runRunner runPrinter   pure resultForest -type HandleForest a b = SpecDefForest a b (MVar (Timed TestRunResult))+type HandleForest a b = SpecDefForest a b (MVar (Timed TestRunReport)) -type HandleTree a b = SpecDefTree a b (MVar (Timed TestRunResult))+type HandleTree a b = SpecDefTree a b (MVar (Timed TestRunReport))  makeHandleForest :: TestForest a b -> IO (HandleForest a b) makeHandleForest = traverse $ traverse $ \() -> newEmptyMVar@@ -56,60 +60,148 @@ runner :: Settings -> Word -> MVar () -> HandleForest '[] () -> IO () runner settings nbThreads failFastVar handleForest = do   sem <- liftIO $ newQSemN $ fromIntegral nbThreads-  jobs <- newIORef (S.empty :: Set (Async ()))+  jobsVar <- newMVar (S.empty :: Set (Async ()))   -- This is used to make sure that the 'after' part of the resources actually happens after the tests are done, not just when they are started.   let waitForCurrentlyRunning :: IO ()       waitForCurrentlyRunning = do-        as <- readIORef jobs-        mapM_ wait as-        writeIORef jobs S.empty-  let goForest :: Parallelism -> FlakinessMode -> HList a -> HandleForest a () -> IO ()-      goForest p fm a = mapM_ (goTree p fm a)-      goTree :: Parallelism -> FlakinessMode -> HList a -> HandleTree a () -> IO ()-      goTree p fm a = \case+        modifyMVar_ jobsVar $ \jobThreads -> do+          mapM_ Async.wait jobThreads+          pure S.empty++  let goForest :: forall a. HandleForest a () -> R a ()+      goForest = mapM_ goTree++      goTree :: forall a. HandleTree a () -> R a ()+      goTree = \case         DefSpecifyNode _ td var -> do-          mDone <- tryReadMVar failFastVar-          case mDone of-            Nothing -> do-              let runNow = timeItT $ runSingleTestWithFlakinessMode noProgressReporter a td fm-              -- Wait before spawning a thread so that we don't spawn too many threads-              let quantity = case p of-                    -- When the test wants to be executed sequentially, we take n locks because we must make sure that-                    -- 1. no more other tests are still running.-                    -- 2. no other tests are started during execution.-                    Sequential -> nbThreads-                    Parallel -> 1-              liftIO $ waitQSemN sem $ fromIntegral quantity-              let job :: IO ()-                  job = do-                    result <- runNow-                    putMVar var result-                    when (settingFailFast settings && testRunResultStatus (timedValue result) == TestFailed) $ do-                      putMVar failFastVar ()-                      as <- readIORef jobs-                      mapM_ cancel as-                    liftIO $ signalQSemN sem $ fromIntegral quantity-              jobAsync <- async job-              modifyIORef jobs (S.insert jobAsync)-              link jobAsync+          -- If the fail-fast var has been put, This will return 'Just ()', in+          -- which case we must stop.+          mDoneEarly <- liftIO $ tryReadMVar failFastVar+          case mDoneEarly of             Just () -> pure ()+            Nothing -> do+              Env {..} <- ask++              liftIO $ do+                -- Wait before spawning a thread so that we don't spawn too many threads+                let quantity = case eParallelism of+                      -- When the test wants to be executed sequentially, we take n locks because we must make sure that+                      -- 1. no more other tests are still running.+                      -- 2. no other tests are started during execution.+                      Sequential -> nbThreads+                      Parallel -> 1+                waitQSemN sem $ fromIntegral quantity++                let runNow =+                      timeItT $+                        runSingleTestWithFlakinessMode+                          noProgressReporter+                          eExternalResources+                          td+                          eRetries+                          eFlakinessMode+                          eExpectationMode+                let job :: IO ()+                    job = do+                      -- Start the test+                      result <- runNow++                      -- Put the result in the mvar+                      putMVar var result++                      -- If we should fail fast, put the fail-fast var and cancel all other jobs.+                      when (settingFailFast settings && testRunReportFailed settings (timedValue result)) $ do+                        putMVar failFastVar ()+                        withMVar jobsVar $ \jobThreads ->+                          mapM_ cancel jobThreads+                      liftIO $ signalQSemN sem $ fromIntegral quantity++                modifyMVar_ jobsVar $ \jobThreads -> do+                  jobThread <- async job+                  link jobThread+                  pure (S.insert jobThread jobThreads)         DefPendingNode _ _ -> pure ()-        DefDescribeNode _ sdf -> goForest p fm a sdf-        DefWrapNode func sdf -> func (goForest p fm a sdf >> waitForCurrentlyRunning)+        DefDescribeNode _ sdf -> goForest sdf+        DefWrapNode func sdf -> do+          e <- ask+          liftIO $+            func $ do+              runReaderT (goForest sdf) e+              waitForCurrentlyRunning         DefBeforeAllNode func sdf -> do-          b <- func-          goForest p fm (HCons b a) sdf-        DefAroundAllNode func sdf ->-          func (\b -> goForest p fm (HCons b a) sdf >> waitForCurrentlyRunning)-        DefAroundAllWithNode func sdf ->-          let HCons x _ = a-           in func (\b -> goForest p fm (HCons b a) sdf >> waitForCurrentlyRunning) x-        DefAfterAllNode func sdf -> goForest p fm a sdf `finally` (waitForCurrentlyRunning >> func a)-        DefParallelismNode p' sdf -> goForest p' fm a sdf-        DefRandomisationNode _ sdf -> goForest p fm a sdf-        DefFlakinessNode fm' sdf -> goForest p fm' a sdf-  goForest Parallel MayNotBeFlaky HNil handleForest+          b <- liftIO func+          withReaderT+            (\e -> e {eExternalResources = HCons b (eExternalResources e)})+            (goForest sdf)+        DefAroundAllNode func sdf -> do+          e <- ask+          liftIO $+            func+              ( \b -> do+                  runReaderT+                    (goForest sdf)+                    (e {eExternalResources = HCons b (eExternalResources e)})+                  waitForCurrentlyRunning+              )+        DefAroundAllWithNode func sdf -> do+          e <- ask+          let HCons x _ = eExternalResources e+          liftIO $+            func+              ( \b -> do+                  runReaderT+                    (goForest sdf)+                    (e {eExternalResources = HCons b (eExternalResources e)})+                  waitForCurrentlyRunning+              )+              x+        DefAfterAllNode func sdf -> do+          e <- ask+          liftIO $+            runReaderT (goForest sdf) e+              `finally` ( do+                            waitForCurrentlyRunning+                            func (eExternalResources e)+                        )+        DefParallelismNode p' sdf ->+          withReaderT+            (\e -> e {eParallelism = p'})+            (goForest sdf)+        DefRandomisationNode _ sdf -> goForest sdf -- Ignore, randomisation has already happened.+        DefRetriesNode modRetries sdf ->+          withReaderT+            (\e -> e {eRetries = modRetries (eRetries e)})+            (goForest sdf)+        DefFlakinessNode fm sdf ->+          withReaderT+            (\e -> e {eFlakinessMode = fm})+            (goForest sdf)+        DefExpectationNode em sdf ->+          withReaderT+            (\e -> e {eExpectationMode = em})+            (goForest sdf) +  runReaderT+    (goForest handleForest)+    Env+      { eParallelism = Parallel,+        eRetries = settingRetries settings,+        eFlakinessMode = MayNotBeFlaky,+        eExpectationMode = ExpectPassing,+        eExternalResources = HNil+      }++type R a = ReaderT (Env a) IO++-- Not exported, on purpose.+data Env externalResources = Env+  { eParallelism :: !Parallelism,+    eRetries :: !Word,+    eFlakinessMode :: !FlakinessMode,+    eExpectationMode :: !ExpectationMode,+    eExternalResources :: !(HList externalResources)+  }+ printer :: Settings -> MVar () -> HandleForest '[] () -> IO (Timed ResultForest) printer settings failFastVar handleForest = do   tc <- deriveTerminalCapababilities settings@@ -125,59 +217,82 @@   let pad :: Int -> [Chunk] -> [Chunk]       pad level = (chunk (T.pack (replicate (paddingSize * level) ' ')) :) -  let goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)-      goForest level hts = do-        rts <- catMaybes <$> mapM (goTree level) hts+  let outputLineP :: [Chunk] -> P ()+      outputLineP line = do+        level <- ask+        liftIO $ outputLine $ pad level line++      outputLinesP :: [[Chunk]] -> P ()+      outputLinesP = mapM_ outputLineP++  let goForest :: HandleForest a b -> P (Maybe ResultForest)+      goForest hts = do+        rts <- catMaybes <$> mapM goTree hts         pure $ if null rts then Nothing else Just rts -      goTree :: Int -> HandleTree a b -> IO (Maybe ResultTree)-      goTree level = \case+      goTree :: HandleTree a b -> P (Maybe ResultTree)+      goTree = \case         DefSpecifyNode t td var -> do-          failFastOrResult <- race (readMVar failFastVar) (takeMVar var)+          failFastOrResult <-+            liftIO $+              race+                (readMVar failFastVar)+                (takeMVar var)           case failFastOrResult of             Left () -> pure Nothing             Right result -> do               let td' = td {testDefVal = result}-              mapM_ (outputLine . pad level) $ outputSpecifyLines level treeWidth t td'+              level <- ask+              outputLinesP $ outputSpecifyLines settings level treeWidth t td'               pure $ Just $ SpecifyNode t td'         DefPendingNode t mr -> do-          mapM_ (outputLine . pad level) $ outputPendingLines t mr+          outputLinesP $ outputPendingLines t mr           pure $ Just $ PendingNode t mr         DefDescribeNode t sf -> do-          mDone <- tryReadMVar failFastVar-          case mDone of-            Nothing -> do-              outputLine $ pad level $ outputDescribeLine t-              fmap (DescribeNode t) <$> goForest (succ level) sf+          mDoneEarly <- liftIO $ tryReadMVar failFastVar+          case mDoneEarly of             Just () -> pure Nothing-        DefWrapNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefBeforeAllNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefAroundAllNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefAroundAllWithNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefAfterAllNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefFlakinessNode _ sdf -> fmap SubForestNode <$> goForest level sdf+            Nothing -> do+              outputLineP $ outputDescribeLine t+              fmap (DescribeNode t) <$> addLevel (goForest sf)+        DefWrapNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefBeforeAllNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefAroundAllNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefAroundAllWithNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefAfterAllNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefRetriesNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefFlakinessNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefExpectationNode _ sdf -> fmap SubForestNode <$> goForest sdf   mapM_ outputLine outputTestsHeader-  resultForest <- timeItT $ fromMaybe [] <$> goForest 0 handleForest+  resultForest <- timeItT $ fromMaybe [] <$> runReaderT (goForest handleForest) 0   outputLine [chunk " "]   mapM_ outputLine $ outputFailuresWithHeading settings (timedValue resultForest)   outputLine [chunk " "]-  mapM_ outputLine $ outputStats (computeTestSuiteStats <$> resultForest)+  mapM_ outputLine $ outputStats (computeTestSuiteStats settings <$> resultForest)   outputLine [chunk " "]   pure resultForest +addLevel :: P a -> P a+addLevel = withReaderT succ++type P = ReaderT Int IO+ waiter :: MVar () -> HandleForest '[] () -> IO ResultForest waiter failFastVar handleForest = do-  let goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)-      goForest level hts = do-        rts <- catMaybes <$> mapM (goTree level) hts+  let goForest :: HandleForest a b -> IO (Maybe ResultForest)+      goForest hts = do+        rts <- catMaybes <$> mapM goTree hts         pure $ if null rts then Nothing else Just rts -      goTree :: Int -> HandleTree a b -> IO (Maybe ResultTree)-      goTree level = \case+      goTree :: HandleTree a b -> IO (Maybe ResultTree)+      goTree = \case         DefSpecifyNode t td var -> do-          failFastOrResult <- race (readMVar failFastVar) (takeMVar var)+          failFastOrResult <-+            race+              (readMVar failFastVar)+              (takeMVar var)           case failFastOrResult of             Left () -> pure Nothing             Right result -> do@@ -185,13 +300,15 @@               pure $ Just $ SpecifyNode t td'         DefPendingNode t mr -> pure $ Just $ PendingNode t mr         DefDescribeNode t sf -> do-          fmap (DescribeNode t) <$> goForest (succ level) sf-        DefWrapNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefBeforeAllNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefAroundAllNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefAroundAllWithNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefAfterAllNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest level sdf-        DefFlakinessNode _ sdf -> fmap SubForestNode <$> goForest level sdf-  fromMaybe [] <$> goForest 0 handleForest+          fmap (DescribeNode t) <$> goForest sf+        DefWrapNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefBeforeAllNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefAroundAllNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefAroundAllWithNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefAfterAllNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefRetriesNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefFlakinessNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefExpectationNode _ sdf -> fmap SubForestNode <$> goForest sdf+  fromMaybe [] <$> goForest handleForest
+ src/Test/Syd/Runner/Single.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Runner.Single (runSingleTestWithFlakinessMode) where++import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Test.Syd.HList+import Test.Syd.Run+import Test.Syd.SpecDef++-- | Run a single test.+--+-- Run the test up to 'maxRetries' times.+-- Finish as soon as the test passes once, or when we run out of retries.+runSingleTestWithFlakinessMode ::+  forall externalResources t.+  -- | How to report test progress+  ProgressReporter ->+  -- | External resources+  HList externalResources ->+  -- | Test definition+  TDef+    ( ProgressReporter ->+      ((HList externalResources -> () -> t) -> t) ->+      IO TestRunResult+    ) ->+  -- | Max retries+  Word ->+  -- | Flakiness mode+  FlakinessMode ->+  -- | Expectation mode+  ExpectationMode ->+  -- | Test result+  IO TestRunReport+runSingleTestWithFlakinessMode progressReporter l td maxRetries fm em = do+  results <- runSingleTestWithRetries progressReporter l td maxRetries em+  pure+    TestRunReport+      { testRunReportExpectationMode = em,+        testRunReportRawResults = results,+        testRunReportFlakinessMode = fm+      }++runSingleTestWithRetries ::+  forall externalResources t.+  -- | How to report test progress+  ProgressReporter ->+  -- | External resources+  HList externalResources ->+  -- | Test definition+  TDef+    ( ProgressReporter ->+      ((HList externalResources -> () -> t) -> t) ->+      IO TestRunResult+    ) ->+  -- | Max retries+  Word ->+  -- | Expectation mode+  ExpectationMode ->+  -- If the test ever passed, and the last test result+  IO (NonEmpty TestRunResult)+runSingleTestWithRetries progressReporter l td maxRetries em = go maxRetries+  where+    go :: Word -> IO (NonEmpty TestRunResult)+    go w+      | w <= 1 = (:| []) <$> runFunc+      | otherwise = do+        result <- runFunc+        if testStatusMatchesExpectationMode (testRunResultStatus result) em+          then pure (result :| [])+          else do+            rest <- go (pred w)+            pure (result NE.<| rest)+      where+        runFunc :: IO TestRunResult+        runFunc = testDefVal td progressReporter (\f -> f l ())
src/Test/Syd/Runner/Synchronous.hs view
@@ -1,169 +1,8 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}---- | This module defines how to run a test suite-module Test.Syd.Runner.Synchronous where--import Control.Exception-import Control.Monad.IO.Class-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import Test.Syd.HList-import Test.Syd.OptParse-import Test.Syd.Output-import Test.Syd.Run-import Test.Syd.Runner.Wrappers-import Test.Syd.SpecDef-import Test.Syd.SpecForest-import Text.Colour--runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest-runSpecForestSynchronously settings = fmap extractNext . goForest MayNotBeFlaky HNil-  where-    goForest :: FlakinessMode -> HList a -> TestForest a () -> IO (Next ResultForest)-    goForest _ _ [] = pure (Continue [])-    goForest f hl (tt : rest) = do-      nrt <- goTree f hl tt-      case nrt of-        Continue rt -> do-          nf <- goForest f hl rest-          pure $ (rt :) <$> nf-        Stop rt -> pure $ Stop [rt]-    goTree :: forall a. FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree)-    goTree fm hl = \case-      DefSpecifyNode t td () -> do-        result <- timeItT $ runSingleTestWithFlakinessMode noProgressReporter hl td fm-        let td' = td {testDefVal = result}-        let r = failFastNext (settingFailFast settings) td'-        pure $ SpecifyNode t <$> r-      DefPendingNode t mr -> pure $ Continue $ PendingNode t mr-      DefDescribeNode t sdf -> fmap (DescribeNode t) <$> goForest fm hl sdf-      DefWrapNode func sdf -> fmap SubForestNode <$> applySimpleWrapper'' func (goForest fm hl sdf)-      DefBeforeAllNode func sdf -> do-        fmap SubForestNode-          <$> ( do-                  b <- func-                  goForest fm (HCons b hl) sdf-              )-      DefAroundAllNode func sdf ->-        fmap SubForestNode <$> applySimpleWrapper' func (\b -> goForest fm (HCons b hl) sdf)-      DefAroundAllWithNode func sdf ->-        let HCons x _ = hl-         in fmap SubForestNode <$> applySimpleWrapper func (\b -> goForest fm (HCons b hl) sdf) x-      DefAfterAllNode func sdf -> fmap SubForestNode <$> (goForest fm hl sdf `finally` func hl)-      DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest fm hl sdf -- Ignore, it's synchronous anyway-      DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest fm hl sdf-      DefFlakinessNode fm' sdf -> fmap SubForestNode <$> goForest fm' hl sdf--runSpecForestInterleavedWithOutputSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest)-runSpecForestInterleavedWithOutputSynchronously settings testForest = do-  tc <- deriveTerminalCapababilities settings-  let outputLine :: [Chunk] -> IO ()-      outputLine lineChunks = liftIO $ do-        putChunksLocaleWith tc lineChunks-        TIO.putStrLn ""-      treeWidth :: Int-      treeWidth = specForestWidth testForest-  let pad :: Int -> [Chunk] -> [Chunk]-      pad level = (chunk (T.pack (replicate (paddingSize * level) ' ')) :)-      goForest :: Int -> FlakinessMode -> HList a -> TestForest a () -> IO (Next ResultForest)-      goForest _ _ _ [] = pure (Continue [])-      goForest level fm l (tt : rest) = do-        nrt <- goTree level fm l tt-        case nrt of-          Continue rt -> do-            nf <- goForest level fm l rest-            pure $ (rt :) <$> nf-          Stop rt -> pure $ Stop [rt]-      goTree :: Int -> FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree)-      goTree level fm hl = \case-        DefSpecifyNode t td () -> do-          let progressReporter :: Progress -> IO ()-              progressReporter =-                outputLine . pad (succ (succ level)) . \case-                  ProgressTestStarting ->-                    [ fore cyan "Test starting: ",-                      fore yellow $ chunk t-                    ]-                  ProgressExampleStarting totalExamples exampleNr ->-                    [ fore cyan "Example starting:  ",-                      fore yellow $ exampleNrChunk totalExamples exampleNr-                    ]-                  ProgressExampleDone totalExamples exampleNr executionTime ->-                    [ fore cyan "Example done:      ",-                      fore yellow $ exampleNrChunk totalExamples exampleNr,-                      timeChunkFor executionTime-                    ]-                  ProgressTestDone ->-                    [ fore cyan "Test done: ",-                      fore yellow $ chunk t-                    ]-          result <- timeItT $ runSingleTestWithFlakinessMode progressReporter hl td fm-          let td' = td {testDefVal = result}-          mapM_ (outputLine . pad level) $ outputSpecifyLines level treeWidth t td'-          let r = failFastNext (settingFailFast settings) td'-          pure $ SpecifyNode t <$> r-        DefPendingNode t mr -> do-          mapM_ (outputLine . pad level) $ outputPendingLines t mr-          pure $ Continue $ PendingNode t mr-        DefDescribeNode t sf -> do-          outputLine $ pad level $ outputDescribeLine t-          fmap (DescribeNode t) <$> goForest (succ level) fm hl sf-        DefWrapNode func sdf -> fmap SubForestNode <$> applySimpleWrapper'' func (goForest level fm hl sdf)-        DefBeforeAllNode func sdf ->-          fmap SubForestNode-            <$> ( do-                    b <- func-                    goForest level fm (HCons b hl) sdf-                )-        DefAroundAllNode func sdf ->-          fmap SubForestNode <$> applySimpleWrapper' func (\b -> goForest level fm (HCons b hl) sdf)-        DefAroundAllWithNode func sdf ->-          let HCons x _ = hl-           in fmap SubForestNode <$> applySimpleWrapper func (\b -> goForest level fm (HCons b hl) sdf) x-        DefAfterAllNode func sdf -> fmap SubForestNode <$> (goForest level fm hl sdf `finally` func hl)-        DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest level fm hl sdf -- Ignore, it's synchronous anyway-        DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest level fm hl sdf-        DefFlakinessNode fm' sdf -> fmap SubForestNode <$> goForest level fm' hl sdf-  mapM_ outputLine outputTestsHeader-  resultForest <- timeItT $ extractNext <$> goForest 0 MayNotBeFlaky HNil testForest-  outputLine [chunk " "]-  mapM_ outputLine $ outputFailuresWithHeading settings (timedValue resultForest)-  outputLine [chunk " "]-  mapM_ outputLine $ outputStats (computeTestSuiteStats <$> resultForest)-  outputLine [chunk " "]--  pure resultForest+module Test.Syd.Runner.Synchronous+  ( runSpecForestSynchronously,+    runSpecForestInterleavedWithOutputSynchronously,+  )+where -runSingleTestWithFlakinessMode :: forall a t. ProgressReporter -> HList a -> TDef (ProgressReporter -> ((HList a -> () -> t) -> t) -> IO TestRunResult) -> FlakinessMode -> IO TestRunResult-runSingleTestWithFlakinessMode progressReporter l td = \case-  MayNotBeFlaky -> runFunc-  MayBeFlakyUpTo retries mMsg -> updateFlakinessMessage <$> go retries-    where-      updateFlakinessMessage :: TestRunResult -> TestRunResult-      updateFlakinessMessage trr = case mMsg of-        Nothing -> trr-        Just msg -> trr {testRunResultFlakinessMessage = Just msg}-      go i-        | i <= 1 = runFunc-        | otherwise = do-            result <- runFunc-            case testRunResultStatus result of-              TestPassed -> pure result-              TestFailed -> updateRetriesResult <$> go (pred i)-        where-          updateRetriesResult :: TestRunResult -> TestRunResult-          updateRetriesResult trr =-            trr-              { testRunResultRetries =-                  case testRunResultRetries trr of-                    Nothing -> Just 1-                    Just r -> Just (succ r)-              }-  where-    runFunc :: IO TestRunResult-    runFunc = testDefVal td progressReporter (\f -> f l ())+import Test.Syd.Runner.Synchronous.Interleaved+import Test.Syd.Runner.Synchronous.Separate
+ src/Test/Syd/Runner/Synchronous/Interleaved.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Syd.Runner.Synchronous.Interleaved (runSpecForestInterleavedWithOutputSynchronously) where++import Control.Exception+import Control.Monad.IO.Class+import Control.Monad.Reader+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import Test.Syd.HList+import Test.Syd.OptParse+import Test.Syd.Output+import Test.Syd.Run+import Test.Syd.Runner.Single+import Test.Syd.Runner.Wrappers+import Test.Syd.SpecDef+import Test.Syd.SpecForest+import Text.Colour++runSpecForestInterleavedWithOutputSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest)+runSpecForestInterleavedWithOutputSynchronously settings testForest = do+  tc <- deriveTerminalCapababilities settings+  let outputLine :: [Chunk] -> IO ()+      outputLine lineChunks = liftIO $ do+        putChunksLocaleWith tc lineChunks+        TIO.putStrLn ""++      treeWidth :: Int+      treeWidth = specForestWidth testForest++  let pad :: Int -> [Chunk] -> [Chunk]+      pad level = (chunk (T.pack (replicate (paddingSize * level) ' ')) :)++  let outputLineR :: [Chunk] -> R a ()+      outputLineR line = do+        level <- asks eLevel+        liftIO $ outputLine $ pad level line++      outputLinesR :: [[Chunk]] -> R a ()+      outputLinesR = mapM_ outputLineR++  let goForest :: TestForest a () -> R a (Next ResultForest)+      goForest [] = pure (Continue [])+      goForest (tt : rest) = do+        nrt <- goTree tt+        case nrt of+          Continue rt -> do+            nf <- goForest rest+            pure $ (rt :) <$> nf+          Stop rt -> pure $ Stop [rt]++      goTree :: TestTree a () -> R a (Next ResultTree)+      goTree = \case+        DefSpecifyNode t td () -> do+          Env {..} <- ask+          let progressReporter :: Progress -> IO ()+              progressReporter =+                outputLine . pad (succ (succ eLevel)) . \case+                  ProgressTestStarting ->+                    [ fore cyan "Test starting: ",+                      fore yellow $ chunk t+                    ]+                  ProgressExampleStarting totalExamples exampleNr ->+                    [ fore cyan "Example starting:  ",+                      fore yellow $ exampleNrChunk totalExamples exampleNr+                    ]+                  ProgressExampleDone totalExamples exampleNr executionTime ->+                    [ fore cyan "Example done:      ",+                      fore yellow $ exampleNrChunk totalExamples exampleNr,+                      timeChunkFor executionTime+                    ]+                  ProgressTestDone ->+                    [ fore cyan "Test done: ",+                      fore yellow $ chunk t+                    ]+          result <-+            liftIO $+              timeItT $+                runSingleTestWithFlakinessMode+                  progressReporter+                  eExternalResources+                  td+                  eRetries+                  eFlakinessMode+                  eExpectationMode+          let td' = td {testDefVal = result}+          outputLinesR $ outputSpecifyLines settings eLevel treeWidth t td'+          let r = failFastNext settings td'+          pure $ SpecifyNode t <$> r+        DefPendingNode t mr -> do+          outputLinesR $ outputPendingLines t mr+          pure $ Continue $ PendingNode t mr+        DefDescribeNode t sdf -> do+          outputLineR $ outputDescribeLine t+          fmap (DescribeNode t) <$> addLevel (goForest sdf)+        DefWrapNode func sdf -> do+          e <- ask+          liftIO $ fmap SubForestNode <$> applySimpleWrapper'' func (runReaderT (goForest sdf) e)+        DefBeforeAllNode func sdf ->+          fmap SubForestNode+            <$> ( do+                    b <- liftIO func+                    withReaderT+                      (\e -> e {eExternalResources = HCons b (eExternalResources e)})+                      (goForest sdf)+                )+        DefAroundAllNode func sdf -> do+          e <- ask+          liftIO $+            fmap SubForestNode+              <$> applySimpleWrapper'+                func+                ( \b ->+                    runReaderT+                      (goForest sdf)+                      (e {eExternalResources = HCons b (eExternalResources e)})+                )+        DefAroundAllWithNode func sdf -> do+          e <- ask+          let HCons x _ = eExternalResources e+          liftIO $+            fmap SubForestNode+              <$> applySimpleWrapper+                func+                ( \b ->+                    runReaderT+                      (goForest sdf)+                      (e {eExternalResources = HCons b (eExternalResources e)})+                )+                x+        DefAfterAllNode func sdf -> do+          e <- ask+          let externalResources = eExternalResources e+          liftIO $ fmap SubForestNode <$> (runReaderT (goForest sdf) e `finally` func externalResources)+        DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest sdf -- Ignore, it's synchronous anyway+        DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest sdf -- Ignore, randomisation has already happened.+        DefRetriesNode modRetries sdf ->+          fmap SubForestNode+            <$> withReaderT+              (\e -> e {eRetries = modRetries (eRetries e)})+              (goForest sdf)+        DefFlakinessNode fm sdf ->+          fmap SubForestNode+            <$> withReaderT+              (\e -> e {eFlakinessMode = fm})+              (goForest sdf)+        DefExpectationNode em sdf ->+          fmap SubForestNode+            <$> withReaderT+              (\e -> e {eExpectationMode = em})+              (goForest sdf)++  mapM_ outputLine outputTestsHeader+  resultForest <-+    timeItT $+      extractNext+        <$> runReaderT+          (goForest testForest)+          Env+            { eLevel = 0,+              eRetries = settingRetries settings,+              eFlakinessMode = MayNotBeFlaky,+              eExpectationMode = ExpectPassing,+              eExternalResources = HNil+            }++  outputLine [chunk " "]+  mapM_ outputLine $ outputFailuresWithHeading settings (timedValue resultForest)+  outputLine [chunk " "]+  mapM_ outputLine $ outputStats (computeTestSuiteStats settings <$> resultForest)+  outputLine [chunk " "]++  pure resultForest++addLevel :: R a b -> R a b+addLevel = withReaderT (\e -> e {eLevel = succ (eLevel e)})++type R a = ReaderT (Env a) IO++-- Not exported, on purpose.+data Env externalResources = Env+  { eLevel :: Int,+    eRetries :: !Word,+    eFlakinessMode :: !FlakinessMode,+    eExpectationMode :: !ExpectationMode,+    eExternalResources :: !(HList externalResources)+  }
+ src/Test/Syd/Runner/Synchronous/Separate.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Syd.Runner.Synchronous.Separate (runSpecForestSynchronously) where++import Control.Exception+import Control.Monad.Reader+import Test.Syd.HList+import Test.Syd.OptParse+import Test.Syd.Run+import Test.Syd.Runner.Single+import Test.Syd.Runner.Wrappers+import Test.Syd.SpecDef+import Test.Syd.SpecForest++runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest+runSpecForestSynchronously settings testForest =+  extractNext+    <$> runReaderT+      (goForest testForest)+      Env+        { eRetries = settingRetries settings,+          eFlakinessMode = MayNotBeFlaky,+          eExpectationMode = ExpectPassing,+          eExternalResources = HNil+        }+  where+    goForest :: forall a. TestForest a () -> R a (Next ResultForest)+    goForest [] = pure (Continue [])+    goForest (tt : rest) = do+      nrt <- goTree tt+      case nrt of+        Continue rt -> do+          nf <- goForest rest+          pure $ (rt :) <$> nf+        Stop rt -> pure $ Stop [rt]++    goTree :: forall a. TestTree a () -> R a (Next ResultTree)+    goTree = \case+      DefSpecifyNode t td () -> do+        Env {..} <- ask+        result <-+          liftIO $+            timeItT $+              runSingleTestWithFlakinessMode+                noProgressReporter+                eExternalResources+                td+                eRetries+                eFlakinessMode+                eExpectationMode+        let td' = td {testDefVal = result}+        let r = failFastNext settings td'+        pure $ SpecifyNode t <$> r+      DefPendingNode t mr -> pure $ Continue $ PendingNode t mr+      DefDescribeNode t sdf -> fmap (DescribeNode t) <$> goForest sdf+      DefWrapNode func sdf -> do+        e <- ask+        liftIO $ fmap SubForestNode <$> applySimpleWrapper'' func (runReaderT (goForest sdf) e)+      DefBeforeAllNode func sdf -> do+        fmap SubForestNode+          <$> ( do+                  b <- liftIO func+                  withReaderT+                    (\e -> e {eExternalResources = HCons b (eExternalResources e)})+                    (goForest sdf)+              )+      DefAroundAllNode func sdf -> do+        e <- ask+        liftIO $+          fmap SubForestNode+            <$> applySimpleWrapper'+              func+              ( \b ->+                  runReaderT+                    (goForest sdf)+                    (e {eExternalResources = HCons b (eExternalResources e)})+              )+      DefAroundAllWithNode func sdf -> do+        e <- ask+        let HCons x _ = eExternalResources e+        liftIO $+          fmap SubForestNode+            <$> applySimpleWrapper+              func+              ( \b ->+                  runReaderT+                    (goForest sdf)+                    (e {eExternalResources = HCons b (eExternalResources e)})+              )+              x+      DefAfterAllNode func sdf -> do+        e <- ask+        let externalResources = eExternalResources e+        liftIO $ fmap SubForestNode <$> (runReaderT (goForest sdf) e `finally` func externalResources)+      DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest sdf -- Ignore, it's synchronous anyway+      DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest sdf -- Ignore, randomisation has already happened.+      DefRetriesNode modRetries sdf ->+        fmap SubForestNode+          <$> withReaderT+            (\e -> e {eRetries = modRetries (eRetries e)})+            (goForest sdf)+      DefFlakinessNode fm sdf ->+        fmap SubForestNode+          <$> withReaderT+            (\e -> e {eFlakinessMode = fm})+            (goForest sdf)+      DefExpectationNode em sdf ->+        fmap SubForestNode+          <$> withReaderT+            (\e -> e {eExpectationMode = em})+            (goForest sdf)++type R a = ReaderT (Env a) IO++-- Not exported, on purpose.+data Env externalResources = Env+  { eRetries :: !Word,+    eFlakinessMode :: !FlakinessMode,+    eExpectationMode :: !ExpectationMode,+    eExternalResources :: !(HList externalResources)+  }
src/Test/Syd/Runner/Wrappers.hs view
@@ -8,6 +8,7 @@  import Control.Concurrent import Control.Monad.IO.Class+import Test.Syd.OptParse import Test.Syd.Run import Test.Syd.SpecDef @@ -18,9 +19,9 @@ extractNext (Continue a) = a extractNext (Stop a) = a -failFastNext :: Bool -> TDef (Timed TestRunResult) -> Next (TDef (Timed TestRunResult))-failFastNext b td@(TDef (Timed trr _) _) =-  if b && testRunResultStatus trr == TestFailed+failFastNext :: Settings -> TDef (Timed TestRunReport) -> Next (TDef (Timed TestRunReport))+failFastNext settings td@(TDef (Timed trr _) _) =+  if settingFailFast settings && testRunReportFailed settings trr     then Stop td     else Continue td 
src/Test/Syd/SpecDef.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -20,11 +21,15 @@ import Control.Monad.Random import Data.DList (DList) import qualified Data.DList as DList+import Data.Foldable (find) import Data.Kind+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Word+import GHC.Generics (Generic) import GHC.Stack import System.Random.Shuffle import Test.QuickCheck.IO ()@@ -112,11 +117,21 @@     ExecutionOrderRandomisation ->     SpecDefForest outers inner extra ->     SpecDefTree outers inner extra+  DefRetriesNode ::+    -- | Modify the number of retries+    (Word -> Word) ->+    SpecDefForest outers inner extra ->+    SpecDefTree outers inner extra   DefFlakinessNode ::-    -- | How many times to retry+    -- | Whether to allow flakiness     FlakinessMode ->     SpecDefForest outers inner extra ->     SpecDefTree outers inner extra+  DefExpectationNode ::+    -- | Whether to expect passing or failing+    ExpectationMode ->+    SpecDefForest outers inner extra ->+    SpecDefTree outers inner extra  instance Functor (SpecDefTree a c) where   fmap :: forall e f. (e -> f) -> SpecDefTree a c e -> SpecDefTree a c f@@ -134,7 +149,9 @@           DefAfterAllNode func sdf -> DefAfterAllNode func $ goF sdf           DefParallelismNode p sdf -> DefParallelismNode p $ goF sdf           DefRandomisationNode p sdf -> DefRandomisationNode p $ goF sdf+          DefRetriesNode p sdf -> DefRetriesNode p $ goF sdf           DefFlakinessNode p sdf -> DefFlakinessNode p $ goF sdf+          DefExpectationNode p sdf -> DefExpectationNode p $ goF sdf  instance Foldable (SpecDefTree a c) where   foldMap :: forall e m. Monoid m => (e -> m) -> SpecDefTree a c e -> m@@ -152,7 +169,9 @@           DefAfterAllNode _ sdf -> goF sdf           DefParallelismNode _ sdf -> goF sdf           DefRandomisationNode _ sdf -> goF sdf+          DefRetriesNode _ sdf -> goF sdf           DefFlakinessNode _ sdf -> goF sdf+          DefExpectationNode _ sdf -> goF sdf  instance Traversable (SpecDefTree a c) where   traverse :: forall u w f. Applicative f => (u -> f w) -> SpecDefTree a c u -> f (SpecDefTree a c w)@@ -170,7 +189,9 @@           DefAfterAllNode func sdf -> DefAfterAllNode func <$> goF sdf           DefParallelismNode p sdf -> DefParallelismNode p <$> goF sdf           DefRandomisationNode p sdf -> DefRandomisationNode p <$> goF sdf+          DefRetriesNode p sdf -> DefRetriesNode p <$> goF sdf           DefFlakinessNode p sdf -> DefFlakinessNode p <$> goF sdf+          DefExpectationNode p sdf -> DefExpectationNode p <$> goF sdf  filterTestForest :: Maybe Text -> SpecDefForest outers inner result -> SpecDefForest outers inner result filterTestForest mf = fromMaybe [] . goForest DList.empty@@ -204,7 +225,9 @@       DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest dl sdf       DefParallelismNode func sdf -> DefParallelismNode func <$> goForest dl sdf       DefRandomisationNode func sdf -> DefRandomisationNode func <$> goForest dl sdf+      DefRetriesNode func sdf -> DefRetriesNode func <$> goForest dl sdf       DefFlakinessNode func sdf -> DefFlakinessNode func <$> goForest dl sdf+      DefExpectationNode func sdf -> DefExpectationNode func <$> goForest dl sdf  randomiseTestForest :: MonadRandom m => SpecDefForest outers inner result -> m (SpecDefForest outers inner result) randomiseTestForest = goForest@@ -222,53 +245,85 @@       DefAroundAllWithNode func sdf -> DefAroundAllWithNode func <$> goForest sdf       DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest sdf       DefParallelismNode func sdf -> DefParallelismNode func <$> goForest sdf+      DefRetriesNode i sdf -> DefRetriesNode i <$> goForest sdf       DefFlakinessNode i sdf -> DefFlakinessNode i <$> goForest sdf+      DefExpectationNode i sdf -> DefExpectationNode i <$> goForest sdf       DefRandomisationNode eor sdf ->         DefRandomisationNode eor <$> case eor of           RandomiseExecutionOrder -> goForest sdf           DoNotRandomiseExecutionOrder -> pure sdf -data Parallelism = Parallel | Sequential+markSpecForestAsPending :: Maybe Text -> SpecDefForest outers inner result -> SpecDefForest outers inner result+markSpecForestAsPending mMessage = goForest+  where+    goForest :: SpecDefForest a b c -> SpecDefForest a b c+    goForest = map goTree -data ExecutionOrderRandomisation = RandomiseExecutionOrder | DoNotRandomiseExecutionOrder+    goTree :: SpecDefTree a b c -> SpecDefTree a b c+    goTree = \case+      DefSpecifyNode t _ _ -> DefPendingNode t mMessage+      DefPendingNode t mr -> DefPendingNode t mr+      DefDescribeNode t sdf -> DefDescribeNode t $ goForest sdf+      DefWrapNode func sdf -> DefWrapNode func $ goForest sdf+      DefBeforeAllNode func sdf -> DefBeforeAllNode func $ goForest sdf+      DefAroundAllNode func sdf -> DefAroundAllNode func $ goForest sdf+      DefAroundAllWithNode func sdf -> DefAroundAllWithNode func $ goForest sdf+      DefAfterAllNode func sdf -> DefAfterAllNode func $ goForest sdf+      DefParallelismNode func sdf -> DefParallelismNode func $ goForest sdf+      DefRetriesNode i sdf -> DefRetriesNode i $ goForest sdf+      DefFlakinessNode i sdf -> DefFlakinessNode i $ goForest sdf+      DefRandomisationNode eor sdf -> DefRandomisationNode eor (goForest sdf)+      DefExpectationNode i sdf -> DefExpectationNode i $ goForest sdf +data Parallelism+  = Parallel+  | Sequential+  deriving (Show, Eq, Generic)++data ExecutionOrderRandomisation+  = RandomiseExecutionOrder+  | DoNotRandomiseExecutionOrder+  deriving (Show, Eq, Generic)+ data FlakinessMode   = MayNotBeFlaky-  | MayBeFlakyUpTo-      !Int-      !(Maybe String) -- A message to show whenever the test is flaky.+  | MayBeFlaky !(Maybe String) -- A message to show whenever the test is flaky.+  deriving (Show, Eq, Generic) -type ResultForest = SpecForest (TDef (Timed TestRunResult))+data ExpectationMode+  = ExpectPassing+  | ExpectFailing+  deriving (Show, Eq, Generic) -type ResultTree = SpecTree (TDef (Timed TestRunResult))+type ResultForest = SpecForest (TDef (Timed TestRunReport)) -computeTestSuiteStats :: ResultForest -> TestSuiteStats-computeTestSuiteStats = goF []+type ResultTree = SpecTree (TDef (Timed TestRunReport))++computeTestSuiteStats :: Settings -> ResultForest -> TestSuiteStats+computeTestSuiteStats settings = goF []   where     goF :: [Text] -> ResultForest -> TestSuiteStats     goF ts = foldMap (goT ts)     goT :: [Text] -> ResultTree -> TestSuiteStats     goT ts = \case-      SpecifyNode tn (TDef (Timed TestRunResult {..} t) _) ->-        TestSuiteStats-          { testSuiteStatSuccesses = case testRunResultStatus of-              TestPassed -> 1-              TestFailed -> 0,-            testSuiteStatExamples = case testRunResultStatus of-              TestPassed -> fromMaybe 1 testRunResultNumTests-              TestFailed -> fromMaybe 1 testRunResultNumTests + fromMaybe 0 testRunResultNumShrinks,-            testSuiteStatFailures = case testRunResultStatus of-              TestPassed -> 0-              TestFailed -> 1,-            testSuiteStatFlakyTests = case testRunResultStatus of-              TestFailed -> 0-              TestPassed -> case testRunResultRetries of-                Nothing -> 0-                Just _ -> 1,-            testSuiteStatPending = 0,-            testSuiteStatSumTime = t,-            testSuiteStatLongestTime = Just (T.intercalate "." (ts ++ [tn]), t)-          }+      SpecifyNode tn (TDef (Timed testRunReport t) _) ->+        let status = testRunReportStatus settings testRunReport+         in TestSuiteStats+              { testSuiteStatSuccesses = case status of+                  TestPassed -> 1+                  TestFailed -> 0,+                testSuiteStatExamples = testRunReportExamples testRunReport,+                testSuiteStatFailures = case status of+                  TestPassed -> 0+                  TestFailed -> 1,+                testSuiteStatFlakyTests =+                  if testRunReportWasFlaky testRunReport+                    then 1+                    else 0,+                testSuiteStatPending = 0,+                testSuiteStatSumTime = t,+                testSuiteStatLongestTime = Just (T.intercalate "." (ts ++ [tn]), t)+              }       PendingNode _ _ ->         TestSuiteStats           { testSuiteStatSuccesses = 0,@@ -323,13 +378,74 @@       }  shouldExitFail :: Settings -> ResultForest -> Bool-shouldExitFail settings = any (any (testFailed settings . timedValue . testDefVal))+shouldExitFail settings = any (any (testRunReportFailed settings . timedValue . testDefVal)) -testFailed :: Settings -> TestRunResult -> Bool-testFailed Settings {..} TestRunResult {..} =-  or-    [ -- Failed-      testRunResultStatus == TestFailed,-      -- Passed but flaky and flakiness isn't allowed-      settingFailOnFlaky && testRunResultStatus == TestPassed && isJust testRunResultRetries-    ]+data TestRunReport = TestRunReport+  { testRunReportExpectationMode :: !ExpectationMode,+    -- | Raw results, including retries, in order+    testRunReportRawResults :: !(NonEmpty TestRunResult),+    testRunReportFlakinessMode :: !FlakinessMode+  }+  deriving (Show, Generic)++testRunReportReportedRun :: TestRunReport -> TestRunResult+testRunReportReportedRun TestRunReport {..} =+  -- We always want to report the last failure if there are any failures.+  -- This is because a passed test does not give us any information, and we+  -- only want to do that if there are no failures.+  let reversed = NE.reverse testRunReportRawResults+   in case find ((== TestFailed) . testRunResultStatus) testRunReportRawResults of+        Nothing -> NE.head reversed+        Just trr -> trr++testRunReportFailed :: Settings -> TestRunReport -> Bool+testRunReportFailed settings testRunReport =+  testRunReportStatus settings testRunReport /= TestPassed++testRunReportStatus :: Settings -> TestRunReport -> TestStatus+testRunReportStatus Settings {..} testRunReport@TestRunReport {..} =+  let wasFlaky = testRunReportWasFlaky testRunReport+      lastResult = NE.last testRunReportRawResults+      actualStatus = case testRunReportFlakinessMode of+        MayNotBeFlaky ->+          if wasFlaky+            then TestFailed+            else testRunResultStatus lastResult+        MayBeFlaky _ ->+          if settingFailOnFlaky && wasFlaky+            then TestFailed+            else+              if any ((== TestPassed) . testRunResultStatus) testRunReportRawResults+                then TestPassed+                else TestFailed+      consideredStatus =+        if testStatusMatchesExpectationMode actualStatus testRunReportExpectationMode+          then TestPassed+          else TestFailed+   in consideredStatus++testStatusMatchesExpectationMode :: TestStatus -> ExpectationMode -> Bool+testStatusMatchesExpectationMode actualStatus expectationMode = case (actualStatus, expectationMode) of+  (TestPassed, ExpectPassing) -> True+  (TestFailed, ExpectFailing) -> True+  _ -> False++testRunReportExamples :: TestRunReport -> Word+testRunReportExamples = sum . NE.map testRunResultExamples . testRunReportRawResults++testRunResultExamples :: TestRunResult -> Word+testRunResultExamples TestRunResult {..} =+  fromMaybe 1 testRunResultNumTests + fromMaybe 0 testRunResultNumShrinks++testRunReportWasFlaky :: TestRunReport -> Bool+testRunReportWasFlaky =+  (> 1)+    . length+    . NE.group+    . NE.map testRunResultStatus+    . testRunReportRawResults++testRunReportRetries :: TestRunReport -> Maybe Word+testRunReportRetries TestRunReport {..} = case NE.length testRunReportRawResults of+  1 -> Nothing+  l -> Just $ fromIntegral l
sydtest.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack  name:           sydtest-version:        0.11.0.2+version:        0.12.0.0 synopsis:       A modern testing framework for Haskell with good defaults and advanced testing features. description:    A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category:       Testing@@ -27,6 +27,7 @@     test_resources/even/odd/3     test_resources/odd/3     test_resources/odd/deep/5+    test_resources/output-test.txt     test_resources/output.golden  source-repository head@@ -53,7 +54,10 @@       Test.Syd.Run       Test.Syd.Runner       Test.Syd.Runner.Asynchronous+      Test.Syd.Runner.Single       Test.Syd.Runner.Synchronous+      Test.Syd.Runner.Synchronous.Interleaved+      Test.Syd.Runner.Synchronous.Separate       Test.Syd.Runner.Wrappers       Test.Syd.SpecDef       Test.Syd.SpecForest@@ -80,24 +84,26 @@     , path-io     , pretty-show     , quickcheck-io+    , random     , random-shuffle     , safe     , safe-coloured-text     , split     , stm     , text-  default-language: Haskell2010   if os(windows)     build-depends:         ansi-terminal   else     build-depends:         safe-coloured-text-terminfo+  default-language: Haskell2010  test-suite sydtest-output-test   type: exitcode-stdio-1.0-  main-is: Spec.hs+  main-is: Main.hs   other-modules:+      Spec       Paths_sydtest   hs-source-dirs:       output-test@@ -106,16 +112,12 @@       QuickCheck     , base >=4.7 && <5     , bytestring-    , path-    , path-io     , random     , safe-coloured-text+    , stm     , sydtest     , text   default-language: Haskell2010-  if !os(windows)-    build-depends:-        safe-coloured-text-terminfo  test-suite sydtest-test   type: exitcode-stdio-1.0@@ -125,6 +127,7 @@       Test.Syd.AroundCombinationSpec       Test.Syd.AroundSpec       Test.Syd.DescriptionsSpec+      Test.Syd.ExpectationSpec       Test.Syd.FootgunSpec       Test.Syd.GoldenSpec       Test.Syd.OptParseSpec
+ test/Test/Syd/ExpectationSpec.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Syd.ExpectationSpec (spec) where++import Test.Syd++spec :: Spec+spec = do+  expectFailing $ do+    it "marks this as passing, because it fails" False+    expectPassing $ it "marks this as passing" True
test_resources/defaultSettings-show.golden view
@@ -12,6 +12,7 @@   , settingFilter = Nothing   , settingFailFast = False   , settingIterations = OneIteration+  , settingRetries = 3   , settingFailOnFlaky = False   , settingReportProgress = ReportNoProgress   , settingDebug = False
+ test_resources/output-test.txt view
@@ -0,0 +1,929 @@+[34mTests:[m++[32m✓ [m[32mPasses[m                                                                            [32m      0.00 ms[m+[33merror[m+  [31m✗ [m[31mPure error[m                                                                      [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mImpure error[m                                                                    [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33mundefined[m+  [31m✗ [m[31mPure undefined[m                                                                  [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mImpure undefined[m                                                                [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[31m✗ [m[31mExit code[m                                                                         [32m      0.00 ms[m+  Retries: 3 (likely not flaky)+[33mexceptions[m+  [31m✗ [m[31mRecord construction error[m                                                       [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mRecord construction error[m+    [31m✗ [m[31mfails in IO, as the result[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in IO, as the action[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in pure code[m                                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [31m✗ [m[31mRecord selection error[m                                                          [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mRecord selection error[m+    [31m✗ [m[31mfails in IO, as the result[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in IO, as the action[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in pure code[m                                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [31m✗ [m[31mRecord update error[m                                                             [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mRecord update error[m+    [31m✗ [m[31mfails in IO, as the result[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in IO, as the action[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in pure code[m                                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [31m✗ [m[31mPattern matching error[m                                                          [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mPattern matching error[m+    [31m✗ [m[31mfails in IO, as the result[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in IO, as the action[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in pure code[m                                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [31m✗ [m[31mArithException[m                                                                  [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mPattern matching error[m+    [31m✗ [m[31mfails in IO, as the result[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in IO, as the action[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in pure code[m                                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [31m✗ [m[31mNoMethodError[m                                                                   [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mPattern matching error[m+    [31m✗ [m[31mfails in IO, as the result[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in IO, as the action[m                                                    [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mfails in pure code[m                                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+[33mPrinting[m+  [32m✓ [m[32mprint[m                                                                           [32m      0.00 ms[m+  [32m✓ [m[32mputStrLn[m                                                                        [32m      0.00 ms[m+[33mProperty tests[m+  [33mpure[m+    [32m✓ [m[32mreversing a list twice is the same as reversing it once[m                       [32m      0.00 ms[m+      passed for all of [32m10[m inputs.+    [31m✗ [m[31mshould fail to show that sorting does nothing[m                                 [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [32m✓ [m[32mshould work with custom generators too[m                                        [32m      0.00 ms[m+      passed for all of [32m10[m inputs.+  [33mimpure[m+    [32m✓ [m[32mreversing a list twice is the same as reversing it once[m                       [32m      0.00 ms[m+      passed for all of [32m10[m inputs.+    [31m✗ [m[31mshould fail to show that sorting does nothing[m                                 [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [32m✓ [m[32mshould work with custom generators too[m                                        [32m      0.00 ms[m+      passed for all of [32m10[m inputs.+[33mLong running tests[m+  [32m✓ [m[32mtakes a while (1)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (2)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (3)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (4)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (5)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (6)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (7)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (8)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (9)[m                                                               [32m      0.00 ms[m+  [32m✓ [m[32mtakes a while (10)[m                                                              [32m      0.00 ms[m+[33mDiff[m+  [31m✗ [m[31mshows nice multi-line diffs[m                                                     [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshows nice multi-line diffs[m                                                     [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33massertions[m+  [31m✗ [m[31mshouldBe[m                                                                        [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshouldNotBe[m                                                                     [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshouldSatisfy[m                                                                   [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshouldNotSatisfy[m                                                                [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshouldSatisfyNamed[m                                                              [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshouldNotSatisfyNamed[m                                                           [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[35mpending test[m+[33mGolden[m+  [31m✗ [m[31mdoes not fail the suite when an exception happens while reading[m                 [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mdoes not fail the suite when an exception happens while producing[m               [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mdoes not fail the suite when an exception happens while writing[m                 [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mdoes not fail the suite when an exception happens while checking for equality[m   [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33moutputResultForest[m+    [32m✓ [m[32moutputs the same as last time[m                                                 [32m      0.00 ms[m+[33mAround[m+  [33mbefore[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33mbefore_[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33mafter[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33mafter_[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33maround[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33maround_[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33maroundWith[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33maroundWith'[m+    [31m✗ [m[31mdoes not kill the test suite[m                                                  [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+[31m✗ [m[31mexpectationFailure[m                                                                [32m      0.00 ms[m+  Retries: 3 (likely not flaky)+[33mString[m+  [31m✗ [m[31mcompares strings[m                                                                [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mcompares strings[m                                                                [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mcompares texts[m                                                                  [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mcompares texts[m                                                                  [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mcompares bytestrings[m                                                            [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33mContext[m+  [31m✗ [m[31mshows a nice context[m                                                            [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshows a nice context multiple levels deep[m                                       [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshows a context when an exception is thrown as well[m                             [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33mProperty[m+  [33m0 tests run[m+    [32m✓ [m[32mshows a red '0 tests' when no tests are run[m                                   [32m      0.00 ms[m+      passed for all of [31m0[m inputs.+  [33mgenerated values[m+    [31m✗ [m[31mshows many generated values too[m                                               [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+  [33mlabels[m+    [32m✓ [m[32mshows the labels in use on success[m                                            [32m      0.00 ms[m+      passed for all of [32m100[m inputs.+      Labels+        31.00% "length of input is 0"+        21.00% "length of input is 1"+        13.00% "length of input is 2"+         8.00% "length of input is 3"+         6.00% "length of input is 4"+        10.00% "length of input is 5"+         6.00% "length of input is 6"+         4.00% "length of input is 7"+         1.00% "length of input is 8"+    [32m✓ [m[32mshows the labels in use on success[m                                            [32m      0.00 ms[m+      passed for all of [32m100[m inputs.+      Labels+        31.00% "length of input is 0", "magnitude (digits) of sum of input is 0"+        13.00% "length of input is 1", "magnitude (digits) of sum of input is 0"+         8.00% "length of input is 1", "magnitude (digits) of sum of input is 1"+         5.00% "length of input is 2", "magnitude (digits) of sum of input is 0"+         7.00% "length of input is 2", "magnitude (digits) of sum of input is 1"+         1.00% "length of input is 2", "magnitude (digits) of sum of input is 2"+         4.00% "length of input is 3", "magnitude (digits) of sum of input is 0"+         3.00% "length of input is 3", "magnitude (digits) of sum of input is 1"+         1.00% "length of input is 3", "magnitude (digits) of sum of input is 2"+         5.00% "length of input is 4", "magnitude (digits) of sum of input is 0"+         1.00% "length of input is 4", "magnitude (digits) of sum of input is 2"+         7.00% "length of input is 5", "magnitude (digits) of sum of input is 0"+         3.00% "length of input is 5", "magnitude (digits) of sum of input is 2"+         5.00% "length of input is 6", "magnitude (digits) of sum of input is 0"+         1.00% "length of input is 6", "magnitude (digits) of sum of input is 2"+         2.00% "length of input is 7", "magnitude (digits) of sum of input is 0"+         2.00% "length of input is 7", "magnitude (digits) of sum of input is 1"+         1.00% "length of input is 8", "magnitude (digits) of sum of input is 0"+    [31m✗ [m[31mshows the labels in use on failure[m                                            [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+      Labels+        100.00% "length of input is 0", "magnitude (digits) of sum of input is 0"+  [33mclasses[m+    [32m✓ [m[32mshows the classes in use on success[m                                           [32m      0.00 ms[m+      passed for all of [32m100[m inputs.+      Classes+        100.00% non-trivial+    [32m✓ [m[32mshows the classes in use on success[m                                           [32m      0.00 ms[m+      passed for all of [32m100[m inputs.+      Classes+        31.00% empty+        48.00% non-trivial+        21.00% single element+    [31m✗ [m[31mshows the classes in use on failure[m                                           [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+      Classes+        100.00% empty+  [33mtables[m+    [32m✓ [m[32mshows the tables in use on success[m                                            [32m      0.00 ms[m+      passed for all of [32m100[m inputs.+       +      List elements+        10.14% -1+         6.45% -2+         7.37% -3+         7.83% -4+         5.07% -5+         4.61% -6+         5.99% -7+         1.38% -8+         0.46% -9+         7.37% 0+         6.91% 1+         6.45% 2+         6.45% 3+         6.45% 4+         4.61% 5+         4.61% 6+         4.61% 7+         1.84% 8+         1.38% 9+[33mShrinking[m+  [31m✗ [m[31mcan grab the mvar during shrinking[m                                              [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33mRetries[m+  [31m✗ [m[31mdoes not retry if the test is configured withoutRetries[m                         [32m      0.00 ms[m+  [31m✗ [m[31mRetries this five times[m                                                         [32m      0.00 ms[m+    Retries: 5 (likely not flaky)+[33mFlakiness[m+  [32m✓ [m[32mAllows flakiness on True eventhough there is none (should succeed)[m              [32m      0.00 ms[m+  [31m✗ [m[31mAllows flakiness on False eventhough there is none (should fail)[m                [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [32m✓ [m[32mallows this intentionally flaky test with the default number of retries[m         [32m      0.00 ms[m+    Retries: 2[31m !!! FLAKY !!![m+    [35mWe're on it![m+  [31m✗ [m[31mDoes not allow flakiness if flakiness is not allowed even if retries happen[m     [32m      0.00 ms[m+    Retries: 2[31m !!! FLAKY !!![m+  [31m✗ [m[31mAllows flakiness in this boolean five times (should fail with 5 retries)[m        [32m      0.00 ms[m+    Retries: 5 (likely not flaky)+  [32m✓ [m[32mallows this intentionally flaky test with up to four retries[m                    [32m      0.00 ms[m+    Retries: 2[31m !!! FLAKY !!![m+    [35mWe're on it![m+[33mxdescribe[m+  [33mtwo pending tests below here[m+    [35mone[m+    [35mtwo[m+  [33mfour pending tests below here[m+    [35mone[m+    [35mtwo[m+    [33mwat[m+      [35mthree[m+      [35mfour[m+[33mcallstack[m+  [31m✗ [m[31mit[m                                                                              [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mspecify[m                                                                         [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mprop[m                                                                            [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [33mdescribe[m+    [31m✗ [m[31mdescribe-it[m                                                                   [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+    [31m✗ [m[31mdescribe-specify[m                                                              [32m      0.00 ms[m+      Retries: 3 (likely not flaky)+[33mexpectations[m+  [32m✓ [m[32mconsidered passing[m                                                              [32m      0.00 ms[m+  [32m✓ [m[32mconsidered passing[m                                                              [32m      0.00 ms[m+  [31m✗ [m[31mconsidered failing[m                                                              [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mconsidered failing[m                                                              [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33mcombinators[m+  [31m✗ [m[31mshould fail[m                                                                     [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [32m✓ [m[32mshould pass[m                                                                     [32m      0.00 ms[m+    passed for all of [32m100[m inputs.+  [31m✗ [m[31mshould not crash (undefined value)[m                                              [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshould not crash (undefined generator)[m                                          [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [31m✗ [m[31mshould be even[m                                                                  [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+  [32m✓ [m[32mshould be even[m                                                                  [32m      0.00 ms[m+  [31m✗ [m[31mshould be even[m                                                                  [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+[33mrandomness[m+  [31m✗ [m[31malways outputs the same pseudorandomness[m                                        [32m      0.00 ms[m+    Retries: 3 (likely not flaky)+++[34mFailures:[m++  [36m  output-test/Spec.hs:35[m+  [31m✗ [m[31m1 [m[31merror.Pure error[m+       Retries: 3 (likely not flaky)+       foobar+       CallStack (from HasCallStack):+         error, called at output-test/Spec.hs:35:28 in main:Spec+  +  [36m  output-test/Spec.hs:36[m+  [31m✗ [m[31m2 [m[31merror.Impure error[m+       Retries: 3 (likely not flaky)+       foobar+       CallStack (from HasCallStack):+         error, called at output-test/Spec.hs:36:24 in main:Spec+  +  [36m  output-test/Spec.hs:38[m+  [31m✗ [m[31m3 [m[31mundefined.Pure undefined[m+       Retries: 3 (likely not flaky)+       Prelude.undefined+       CallStack (from HasCallStack):+         error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+         undefined, called at output-test/Spec.hs:38:31 in main:Spec+  +  [36m  output-test/Spec.hs:39[m+  [31m✗ [m[31m4 [m[31mundefined.Impure undefined[m+       Retries: 3 (likely not flaky)+       Prelude.undefined+       CallStack (from HasCallStack):+         error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+         undefined, called at output-test/Spec.hs:39:28 in main:Spec+  +  [36m  output-test/Spec.hs:40[m+  [31m✗ [m[31m5 [m[31mExit code[m+       Retries: 3 (likely not flaky)+       ExitFailure 1+  +  [36m  output-test/Spec.hs:48[m+  [31m✗ [m[31m6 [m[31mexceptions.Record construction error[m+       Retries: 3 (likely not flaky)+       test+  +  [36m  output-test/Spec.hs:45[m+  [31m✗ [m[31m7 [m[31mexceptions.Record construction error.fails in IO, as the result[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:49:57-64: Missing field in record construction field+  +  [36m  output-test/Spec.hs:46[m+  [31m✗ [m[31m8 [m[31mexceptions.Record construction error.fails in IO, as the action[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:49:57-64: Missing field in record construction field+  +  [36m  output-test/Spec.hs:47[m+  [31m✗ [m[31m9 [m[31mexceptions.Record construction error.fails in pure code[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:49:57-64: Missing field in record construction field+  +  [36m  output-test/Spec.hs:50[m+  [31m✗ [m[31m10 [m[31mexceptions.Record selection error[m+       Retries: 3 (likely not flaky)+       test+  +  [36m  output-test/Spec.hs:45[m+  [31m✗ [m[31m11 [m[31mexceptions.Record selection error.fails in IO, as the result[m+       Retries: 3 (likely not flaky)+       No match in record selector field+  +  [36m  output-test/Spec.hs:46[m+  [31m✗ [m[31m12 [m[31mexceptions.Record selection error.fails in IO, as the action[m+       Retries: 3 (likely not flaky)+       No match in record selector field+  +  [36m  output-test/Spec.hs:47[m+  [31m✗ [m[31m13 [m[31mexceptions.Record selection error.fails in pure code[m+       Retries: 3 (likely not flaky)+       No match in record selector field+  +  [36m  output-test/Spec.hs:52[m+  [31m✗ [m[31m14 [m[31mexceptions.Record update error[m+       Retries: 3 (likely not flaky)+       test+  +  [36m  output-test/Spec.hs:45[m+  [31m✗ [m[31m15 [m[31mexceptions.Record update error.fails in IO, as the result[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:53:60-88: Non-exhaustive patterns in record update+  +  [36m  output-test/Spec.hs:46[m+  [31m✗ [m[31m16 [m[31mexceptions.Record update error.fails in IO, as the action[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:53:60-88: Non-exhaustive patterns in record update+  +  [36m  output-test/Spec.hs:47[m+  [31m✗ [m[31m17 [m[31mexceptions.Record update error.fails in pure code[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:53:60-88: Non-exhaustive patterns in record update+  +  [36m  output-test/Spec.hs:54[m+  [31m✗ [m[31m18 [m[31mexceptions.Pattern matching error[m+       Retries: 3 (likely not flaky)+       test+  +  [36m  output-test/Spec.hs:45[m+  [31m✗ [m[31m19 [m[31mexceptions.Pattern matching error.fails in IO, as the result[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:55:50-64: Non-exhaustive patterns in Cons1 s+  +  [36m  output-test/Spec.hs:46[m+  [31m✗ [m[31m20 [m[31mexceptions.Pattern matching error.fails in IO, as the action[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:55:50-64: Non-exhaustive patterns in Cons1 s+  +  [36m  output-test/Spec.hs:47[m+  [31m✗ [m[31m21 [m[31mexceptions.Pattern matching error.fails in pure code[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:55:50-64: Non-exhaustive patterns in Cons1 s+  +  [36m  output-test/Spec.hs:56[m+  [31m✗ [m[31m22 [m[31mexceptions.ArithException[m+       Retries: 3 (likely not flaky)+       arithmetic underflow+  +  [36m  output-test/Spec.hs:45[m+  [31m✗ [m[31m23 [m[31mexceptions.Pattern matching error.fails in IO, as the result[m+       Retries: 3 (likely not flaky)+       divide by zero+  +  [36m  output-test/Spec.hs:46[m+  [31m✗ [m[31m24 [m[31mexceptions.Pattern matching error.fails in IO, as the action[m+       Retries: 3 (likely not flaky)+       divide by zero+  +  [36m  output-test/Spec.hs:47[m+  [31m✗ [m[31m25 [m[31mexceptions.Pattern matching error.fails in pure code[m+       Retries: 3 (likely not flaky)+       divide by zero+  +  [36m  output-test/Spec.hs:58[m+  [31m✗ [m[31m26 [m[31mexceptions.NoMethodError[m+       Retries: 3 (likely not flaky)+       test+  +  [36m  output-test/Spec.hs:45[m+  [31m✗ [m[31m27 [m[31mexceptions.Pattern matching error.fails in IO, as the result[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:29:10-19: No instance nor default method for class operation toUnit+  +  [36m  output-test/Spec.hs:46[m+  [31m✗ [m[31m28 [m[31mexceptions.Pattern matching error.fails in IO, as the action[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:29:10-19: No instance nor default method for class operation toUnit+  +  [36m  output-test/Spec.hs:47[m+  [31m✗ [m[31m29 [m[31mexceptions.Pattern matching error.fails in pure code[m+       Retries: 3 (likely not flaky)+       output-test/Spec.hs:29:10-19: No instance nor default method for class operation toUnit+  +  [36m  output-test/Spec.hs:72[m+  [31m✗ [m[31m30 [m[31mProperty tests.pure.should fail to show that sorting does nothing[m+       Retries: 3 (likely not flaky)+       Failed after 3 tests+       Generated: [33m[-5,3,11,-3,-13,0,19,-10,15,-13,1,-12,10,-18,-3,-2,6,-9,-6][m+  +  [36m  output-test/Spec.hs:80[m+  [31m✗ [m[31m31 [m[31mProperty tests.impure.should fail to show that sorting does nothing[m+       Retries: 3 (likely not flaky)+       Failed after 3 tests+       Generated: [33m[-5,3,11,-3,-13,0,19,-10,15,-13,1,-12,10,-18,-3,-2,6,-9,-6][m+       Expected these values to be equal:+       [34mActual:   [m+       [ -[31m1[m[31m8[m+       , [31m-[m[31m1[m3+       , [31m-[m1[31m3[m+       , -[31m1[m[31m2[m+       , -10+       , [31m-[m9+       , -[31m6[m+       , [31m-[m5+       , -3+       , [31m-[m[31m3[m+       , -2+       , 0+       , 1+       , 3+       , [31m6[m+       [31m,[m[31m [m[31m1[m[31m0[m+       , [31m1[m[31m1[m+       , [31m1[m[31m5[m+       , [31m1[m[31m9[m+       ]+       [34mExpected: [m+       [ -[32m5[m+       , 3+       , 1[32m1[m+       , -[32m3[m+       , -1[32m3[m+       [32m,[m[32m [m0+       , [32m1[m9+       , -[32m1[m[32m0[m+       , [32m1[m5+       , -[32m1[m3+       , [32m1[m+       , -[32m1[m2+       , [32m1[m0+       , [32m-[m1[32m8[m+       , [32m-[m3+       , [32m-[m[32m2[m+       , [32m6[m+       , [32m-[m[32m9[m+       , [32m-[m[32m6[m+       ]+       [34mInline diff: [m+       [ -[31m1[m[31m8[m[32m5[m+       , [31m-[m[31m1[m3+       , [31m-[m1[31m3[m[32m1[m+       , -[31m1[m[31m2[m[32m3[m+       , -1[32m3[m+       [32m,[m[32m [m0+       , [31m-[m[32m1[m9+       , -[31m6[m[32m1[m[32m0[m+       , [31m-[m[32m1[m5+       , -[32m1[m3+       , [31m-[m[31m3[m[32m1[m+       , -[32m1[m2+       , [32m1[m0+       , [32m-[m1[32m8[m+       , [32m-[m3+       , [31m6[m+       [31m,[m[31m [m[31m1[m[31m0[m[32m-[m[32m2[m+       , [31m1[m[31m1[m[32m6[m+       , [31m1[m[31m5[m[32m-[m[32m9[m+       , [31m1[m[31m9[m[32m-[m[32m6[m+       ]+  +  [36m  output-test/Spec.hs:90[m+  [31m✗ [m[31m32 [m[31mDiff.shows nice multi-line diffs[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m+       ( "foo"+       , [ "quux" , "quux" , "quux" , "quux" , "quux" , "quux" [31m,[m[31m [m[31m"[m[31mq[m[31mu[m[31mu[m[31mx[m[31m"[m[31m [m]+       , "ba[31mr[m"+       )+       [34mExpected: [m+       ( "foo[32mf[m[32mo[m[32mo[m"+       , [ "quux" , "quux" , "quux" , "quux" , "quux" , "quux" ]+       , "ba[32mz[m"+       )+       [34mInline diff: [m+       ( "foo[32mf[m[32mo[m[32mo[m"+       , [ "quux" , "quux" , "quux" , "quux" , "quux" , "quux" [31m,[m[31m [m[31m"[m[31mq[m[31mu[m[31mu[m[31mx[m[31m"[m[31m [m]+       , "ba[31mr[m[32mz[m"+       )+  +  [36m  output-test/Spec.hs:92[m+  [31m✗ [m[31m33 [m[31mDiff.shows nice multi-line diffs[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m( "foo"[31m [m, [[31m][m , "ba[31mr[m"[31m [m)+       [34mExpected: [m+       ( "foo[32mf[m[32mo[m[32mo[m"+       , [ [32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m, "[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m][m+       [32m,[m[32m [m[32m"[mba[32mz[m"+       )+       [34mInline diff: [m+       ( "foo[32mf[m[32mo[m[32mo[m"[31m [m+       , [[31m][m [32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m, "[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m,[m[32m [m[32m"[m[32mq[m[32mu[m[32mu[m[32mx[m[32m"[m[32m [m[32m][m+       [32m,[m[32m [m[32m"[mba[31mr[m[32mz[m"[31m [m+       )+  +  [36m  output-test/Spec.hs:95[m+  [31m✗ [m[31m34 [m[31massertions.shouldBe[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m[31m3[m+       [34mExpected: [m[32m4[m+  +  [36m  output-test/Spec.hs:96[m+  [31m✗ [m[31m35 [m[31massertions.shouldNotBe[m+       Retries: 3 (likely not flaky)+       Did not expect equality of the values but both were:+       3+  +  [36m  output-test/Spec.hs:97[m+  [31m✗ [m[31m36 [m[31massertions.shouldSatisfy[m+       Retries: 3 (likely not flaky)+       Predicate failed, but should have succeeded, on this value:+       3+  +  [36m  output-test/Spec.hs:98[m+  [31m✗ [m[31m37 [m[31massertions.shouldNotSatisfy[m+       Retries: 3 (likely not flaky)+       Predicate succeeded, but should have failed, on this value:+       3+  +  [36m  output-test/Spec.hs:99[m+  [31m✗ [m[31m38 [m[31massertions.shouldSatisfyNamed[m+       Retries: 3 (likely not flaky)+       Predicate failed, but should have succeeded, on this value:+       3+       Predicate: even+  +  [36m  output-test/Spec.hs:100[m+  [31m✗ [m[31m39 [m[31massertions.shouldNotSatisfyNamed[m+       Retries: 3 (likely not flaky)+       Predicate succeeded, but should have failed, on this value:+       3+       Predicate: odd+  +  [36m  output-test/Spec.hs:103[m+  [31m✗ [m[31m40 [m[31mGolden.does not fail the suite when an exception happens while reading[m+       Retries: 3 (likely not flaky)+       ExitFailure 1+  +  [36m  output-test/Spec.hs:111[m+  [31m✗ [m[31m41 [m[31mGolden.does not fail the suite when an exception happens while producing[m+       Retries: 3 (likely not flaky)+       ExitFailure 1+  +  [36m  output-test/Spec.hs:119[m+  [31m✗ [m[31m42 [m[31mGolden.does not fail the suite when an exception happens while writing[m+       Retries: 3 (likely not flaky)+       ExitFailure 1+  +  [36m  output-test/Spec.hs:126[m+  [31m✗ [m[31m43 [m[31mGolden.does not fail the suite when an exception happens while checking for equality[m+       Retries: 3 (likely not flaky)+       divide by zero+  +  [36m  output-test/Spec.hs:149[m+  [31m✗ [m[31m44 [m[31mAround.before.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:154[m+  [31m✗ [m[31m45 [m[31mAround.before_.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:159[m+  [31m✗ [m[31m46 [m[31mAround.after.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:164[m+  [31m✗ [m[31m47 [m[31mAround.after_.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:169[m+  [31m✗ [m[31m48 [m[31mAround.around.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:174[m+  [31m✗ [m[31m49 [m[31mAround.around_.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:179[m+  [31m✗ [m[31m50 [m[31mAround.aroundWith.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:184[m+  [31m✗ [m[31m51 [m[31mAround.aroundWith'.does not kill the test suite[m+       Retries: 3 (likely not flaky)+       user error (test)+  +  [36m  output-test/Spec.hs:187[m+  [31m✗ [m[31m52 [m[31mexpectationFailure[m+       Retries: 3 (likely not flaky)+       fails+  +  [36m  output-test/Spec.hs:190[m+  [31m✗ [m[31m53 [m[31mString.compares strings[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m"fo[31mo[m\nba[31mr[m\tq[31mu[m[31mu[mx[31m [m"+       [34mExpected: [m"fo[32mq[m\nba[32mz[m\tq[32me[mx"+  +  [36m  output-test/Spec.hs:191[m+  [31m✗ [m[31m54 [m[31mString.compares strings[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m+       fo[31mo[m+       ba[31mr[m	q[31mu[m[31mu[mx[31m [m+       [34mExpected: [m+       fo[32mq[m+       ba[32mz[m	q[32me[mx+       [34mInline diff: [m+       fo[31mo[m[32mq[m+       ba[31mr[m[32mz[m	q[31mu[m[31mu[m[32me[mx[31m [m+  +  [36m  output-test/Spec.hs:192[m+  [31m✗ [m[31m55 [m[31mString.compares texts[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m"fo[31mo[m\nba[31mr[m\tq[31mu[m[31mu[mx[31m [m"+       [34mExpected: [m"fo[32mq[m\nba[32mz[m\tq[32me[mx"+  +  [36m  output-test/Spec.hs:193[m+  [31m✗ [m[31m56 [m[31mString.compares texts[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m+       fo[31mo[m+       ba[31mr[m	q[31mu[m[31mu[mx[31m [m+       [34mExpected: [m+       fo[32mq[m+       ba[32mz[m	q[32me[mx+       [34mInline diff: [m+       fo[31mo[m[32mq[m+       ba[31mr[m[32mz[m	q[31mu[m[31mu[m[32me[mx[31m [m+  +  [36m  output-test/Spec.hs:194[m+  [31m✗ [m[31m57 [m[31mString.compares bytestrings[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m"fo[31mo[m\nba[31mr[m\tq[31mu[m[31mu[mx[31m [m"+       [34mExpected: [m"fo[32mq[m\nba[32mz[m\tq[32me[mx"+  +  [36m  output-test/Spec.hs:197[m+  [31m✗ [m[31m58 [m[31mContext.shows a nice context[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m[31mT[m[31mr[m[31mu[me+       [34mExpected: [m[32mF[m[32ma[m[32ml[m[32ms[me+       Context+  +  [36m  output-test/Spec.hs:198[m+  [31m✗ [m[31m59 [m[31mContext.shows a nice context multiple levels deep[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m[31mT[m[31mr[m[31mu[me+       [34mExpected: [m[32mF[m[32ma[m[32ml[m[32ms[me+       Context3+       Context2+       Context1+  +  [36m  output-test/Spec.hs:203[m+  [31m✗ [m[31m60 [m[31mContext.shows a context when an exception is thrown as well[m+       Retries: 3 (likely not flaky)+       Prelude.undefined+       CallStack (from HasCallStack):+         error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+         undefined, called at output-test/Spec.hs:204:26 in main:Spec+       context+  +  [36m  output-test/Spec.hs:210[m+  [31m✗ [m[31m61 [m[31mProperty.generated values.shows many generated values too[m+       Retries: 3 (likely not flaky)+       Failed after 1 tests+       Generated: [33m0[m+       Generated: [33m0[m+       Generated: [33m0[m+       Generated: [33m0[m+       Generated: [33m0[m+       Expected these values to be equal:+       [34mActual:   [m[31m0[m+       [34mExpected: [m[32m1[m+  +  [36m  output-test/Spec.hs:229[m+  [31m✗ [m[31m62 [m[31mProperty.labels.shows the labels in use on failure[m+       Retries: 3 (likely not flaky)+       Failed after 1 tests+       Generated: [33m[][m+       Labels: "length of input is 0", "magnitude (digits) of sum of input is 0"+       Expected these values to be equal:+       [34mActual:   [m[]+       [34mExpected: [m[[32m [m[32m0[m[32m [m]+  +  [36m  output-test/Spec.hs:246[m+  [31m✗ [m[31m63 [m[31mProperty.classes.shows the classes in use on failure[m+       Retries: 3 (likely not flaky)+       Failed after 1 tests+       Generated: [33m[][m+       Class: empty+       Expected these values to be equal:+       [34mActual:   [m[]+       [34mExpected: [m[[32m [m[32m0[m[32m [m]+  +  [36m  output-test/Spec.hs:269[m+  [31m✗ [m[31m64 [m[31mShrinking.can grab the mvar during shrinking[m+       Retries: 3 (likely not flaky)+       Failed after 21 tests+       Generated: [33m20[m+       Predicate failed, but should have succeeded, on this value:+       20+  +  [36m  output-test/Spec.hs:276[m+  [31m✗ [m[31m65 [m[31mRetries.does not retry if the test is configured withoutRetries[m+  +  [36m  output-test/Spec.hs:278[m+  [31m✗ [m[31m66 [m[31mRetries.Retries this five times[m+       Retries: 5 (likely not flaky)+  +  [36m  output-test/Spec.hs:283[m+  [31m✗ [m[31m67 [m[31mFlakiness.Allows flakiness on False eventhough there is none (should fail)[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:292[m+  [31m✗ [m[31m68 [m[31mFlakiness.Does not allow flakiness if flakiness is not allowed even if retries happen[m+       Retries: 2[31m !!! FLAKY !!![m+       Expected these values to be equal:+       [34mActual:   [m[31m1[m+       [34mExpected: [m[32m2[m+  +  [36m  output-test/Spec.hs:296[m+  [31m✗ [m[31m69 [m[31mFlakiness.Allows flakiness in this boolean five times (should fail with 5 retries)[m+       Retries: 5 (likely not flaky)+  +  [36m  output-test/Spec.hs:316[m+  [31m✗ [m[31m70 [m[31mcallstack.it[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:317[m+  [31m✗ [m[31m71 [m[31mcallstack.specify[m+       Retries: 3 (likely not flaky)+  +  [36m  Unknown location[m+  [31m✗ [m[31m72 [m[31mcallstack.prop[m+       Retries: 3 (likely not flaky)+       Failed after 1 tests+  +  [36m  output-test/Spec.hs:320[m+  [31m✗ [m[31m73 [m[31mcallstack.describe.describe-it[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:321[m+  [31m✗ [m[31m74 [m[31mcallstack.describe.describe-specify[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:328[m+  [31m✗ [m[31m75 [m[31mexpectations.considered failing[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:329[m+  [31m✗ [m[31m76 [m[31mexpectations.considered failing[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:336[m+  [31m✗ [m[31m77 [m[31mcombinators.should fail[m+       Retries: 3 (likely not flaky)+       Failed after 2 tests+       Generated: [33m-1[m+  +  [36m  output-test/Spec.hs:338[m+  [31m✗ [m[31m78 [m[31mcombinators.should not crash (undefined value)[m+       Retries: 3 (likely not flaky)+       Failed after 1 tests+       Generated: [33m0[m+       Prelude.undefined+       CallStack (from HasCallStack):+         error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+         undefined, called at output-test/Spec.hs:338:80 in main:Spec+  +  [36m  output-test/Spec.hs:339[m+  [31m✗ [m[31m79 [m[31mcombinators.should not crash (undefined generator)[m+       Retries: 3 (likely not flaky)+       Failed after 1 tests+       Generated: [33mException thrown while showing test case:+  Prelude.undefined+  CallStack (from HasCallStack):+    error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+    undefined, called at output-test/Spec.hs:339:74 in main:Spec+[m+       Prelude.undefined+       CallStack (from HasCallStack):+         error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+         undefined, called at output-test/Spec.hs:339:74 in main:Spec+  +  [36m  output-test/Spec.hs:342[m+  [31m✗ [m[31m80 [m[31mcombinators.should be even[m+       Retries: 3 (likely not flaky)+  +  [36m  output-test/Spec.hs:342[m+  [31m✗ [m[31m81 [m[31mcombinators.should be even[m+       Retries: 3 (likely not flaky)+       Prelude.undefined+       CallStack (from HasCallStack):+         error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err+         undefined, called at output-test/Spec.hs:345:29 in main:Spec+  +  [36m  output-test/Spec.hs:348[m+  [31m✗ [m[31m82 [m[31mrandomness.always outputs the same pseudorandomness[m+       Retries: 3 (likely not flaky)+       Expected these values to be equal:+       [34mActual:   [m[31m4[m[31m9[m+       [34mExpected: [m[32m2[m+  ++  Examples:                     [32m984[m+  Passed:                       [32m31[m+  Failed:                       [31m82[m+  Flaky:                        [31m3[m+  Pending:                      [35m7[m+  Longest test took:   [33m         0.00 seconds[m+  Sum of test runtimes:[33m         0.00 seconds[m+  Test suite took:     [33m         0.00 seconds[m+