sydtest 0.6.0.0 → 0.6.1.0
raw patch · 8 files changed
+71/−30 lines, 8 files
Files
- CHANGELOG.md +6/−0
- output-test/Spec.hs +1/−1
- src/Test/Syd/Modify.hs +21/−4
- src/Test/Syd/Output.hs +8/−4
- src/Test/Syd/Run.hs +6/−1
- src/Test/Syd/Runner/Synchronous.hs +22/−17
- src/Test/Syd/SpecDef.hs +5/−1
- sydtest.cabal +2/−2
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## [0.6.1.0] - 2021-12-10++### Added++* The `flakyWith` combinator, which is like `flaky`, but lets you also add a message to your team.+ ## [0.6.0.0] - 2021-11-12 ### Changed
output-test/Spec.hs view
@@ -283,7 +283,7 @@ flaky 3 $ do it "can retry booleans" False notFlaky $ it "does not retry booleans that have been explicitly marked as 'notFlaky'" False- flaky 100 $+ flakyWith 100 "We're on it!" $ it "can retry randomness" $ do i <- randomRIO (1, 10) i `shouldBe` (1 :: Int)
src/Test/Syd/Modify.hs view
@@ -25,6 +25,7 @@ -- * Declaring flakiness flaky,+ flakyWith, notFlaky, withFlakiness, FlakinessMode (..),@@ -60,15 +61,19 @@ parallel :: TestDefM a b c -> TestDefM a b c parallel = withParallelism Parallel +-- | Annotate a test group with 'Parallelism'. withParallelism :: Parallelism -> TestDefM a b c -> TestDefM a b c withParallelism p = censor ((: []) . DefParallelismNode p) -randomiseExecutionOrder :: TestDefM a b c -> TestDefM a b c-randomiseExecutionOrder = withExecutionOrderRandomisation RandomiseExecutionOrder-+-- | Declare that the order of execution of all tests below must not be randomised. doNotRandomiseExecutionOrder :: TestDefM a b c -> TestDefM a b c doNotRandomiseExecutionOrder = withExecutionOrderRandomisation DoNotRandomiseExecutionOrder +-- | Declare that the order of execution of all tests below may be randomised.+randomiseExecutionOrder :: TestDefM a b c -> TestDefM a b c+randomiseExecutionOrder = withExecutionOrderRandomisation RandomiseExecutionOrder++-- | Annotate a test group with 'ExecutionOrderRandomisation'. withExecutionOrderRandomisation :: ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c withExecutionOrderRandomisation p = censor ((: []) . DefRandomisationNode p) @@ -82,10 +87,22 @@ -- 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+flaky i = withFlakiness $ MayBeFlakyUpTo i 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)++-- | Mark a test suite as "must not be flaky".+--+-- This is useful to have a subgroup of a group marked as 'flaky' that must not be flaky afteral. notFlaky :: TestDefM a b c -> TestDefM a b c notFlaky = withFlakiness MayNotBeFlaky +-- | Annotate a test group with 'FlakinessMode'. withFlakiness :: FlakinessMode -> TestDefM a b c -> TestDefM a b c withFlakiness f = censor ((: []) . DefFlakinessNode f)
src/Test/Syd/Output.hs view
@@ -188,7 +188,7 @@ withTimingColour $ chunk executionTimeText ] ],- map pad $ retriesChunks testRunResultStatus testRunResultRetries,+ map pad $ retriesChunks testRunResultStatus testRunResultRetries testRunResultFlakinessMessage, [ pad [ chunk "passed for all of ", case w of@@ -205,11 +205,15 @@ [pad $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase] ] -retriesChunks :: TestStatus -> Maybe Int -> [[Chunk]]-retriesChunks status = \case+retriesChunks :: TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]+retriesChunks status mRetries mMessage = case mRetries of Nothing -> [] Just retries -> case status of- TestPassed -> [["Retries: ", chunk (T.pack (show retries)), fore red " !! FLAKY !!"]]+ 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)"]] labelsChunks :: Maybe (Map [String] Int) -> [[Chunk]]
src/Test/Syd/Run.hs view
@@ -82,6 +82,7 @@ let testRunResultLabels = Nothing let testRunResultClasses = Nothing let testRunResultTables = Nothing+ let testRunResultFlakinessMessage = Nothing pure TestRunResult {..} applyWrapper2 ::@@ -147,6 +148,7 @@ let testRunResultLabels = Nothing let testRunResultClasses = Nothing let testRunResultTables = Nothing+ let testRunResultFlakinessMessage = Nothing pure TestRunResult {..} instance IsTest Property where@@ -188,6 +190,7 @@ let testRunResultGoldenCase = Nothing let testRunResultNumTests = Just $ fromIntegral $ numTests qcr let testRunResultRetries = Nothing+ let testRunResultFlakinessMessage = Nothing case qcr of Success {} -> do let testRunResultStatus = TestPassed@@ -340,6 +343,7 @@ let testRunResultLabels = Nothing let testRunResultClasses = Nothing let testRunResultTables = Nothing+ let testRunResultFlakinessMessage = Nothing pure TestRunResult {..} exceptionHandlers :: [Handler (Either (Either String Assertion) a)]@@ -403,7 +407,8 @@ testRunResultClasses :: !(Maybe (Map String Int)), testRunResultTables :: !(Maybe (Map String (Map String Int))), testRunResultGoldenCase :: !(Maybe GoldenCase),- testRunResultExtraInfo :: !(Maybe String)+ testRunResultExtraInfo :: !(Maybe String),+ testRunResultFlakinessMessage :: !(Maybe String) } deriving (Show, Eq, Generic)
src/Test/Syd/Runner/Synchronous.hs view
@@ -120,22 +120,27 @@ runSingleTestWithFlakinessMode :: forall a t. HList a -> TDef (((HList a -> () -> t) -> t) -> IO TestRunResult) -> FlakinessMode -> IO TestRunResult runSingleTestWithFlakinessMode l td = \case MayNotBeFlaky -> runFunc- MayBeFlakyUpTo i -> go i+ 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 = testDefVal td (\f -> f l ())- 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)- }
src/Test/Syd/SpecDef.hs view
@@ -171,7 +171,11 @@ data ExecutionOrderRandomisation = RandomiseExecutionOrder | DoNotRandomiseExecutionOrder -data FlakinessMode = MayNotBeFlaky | MayBeFlakyUpTo !Int+data FlakinessMode+ = MayNotBeFlaky+ | MayBeFlakyUpTo+ !Int+ !(Maybe String) -- A message to show whenever the test is flaky. type ResultForest = SpecForest (TDef (Timed TestRunResult))
sydtest.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack name: sydtest-version: 0.6.0.0+version: 0.6.1.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