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 +24/−0
- output-test/Main.hs +59/−0
- output-test/Spec.hs +124/−67
- src/Test/Syd.hs +22/−1
- src/Test/Syd/Def/Around.hs +2/−0
- src/Test/Syd/Def/Specify.hs +10/−11
- src/Test/Syd/Modify.hs +51/−5
- src/Test/Syd/OptParse.hs +28/−5
- src/Test/Syd/Output.hs +106/−99
- src/Test/Syd/Run.hs +1/−11
- src/Test/Syd/Runner.hs +31/−21
- src/Test/Syd/Runner/Asynchronous.hs +208/−91
- src/Test/Syd/Runner/Single.hs +76/−0
- src/Test/Syd/Runner/Synchronous.hs +7/−168
- src/Test/Syd/Runner/Synchronous/Interleaved.hs +193/−0
- src/Test/Syd/Runner/Synchronous/Separate.hs +126/−0
- src/Test/Syd/Runner/Wrappers.hs +4/−3
- src/Test/Syd/SpecDef.hs +155/−39
- sydtest.cabal +12/−9
- test/Test/Syd/ExpectationSpec.hs +13/−0
- test_resources/defaultSettings-show.golden +1/−0
- test_resources/output-test.txt +929/−0
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+