tasty-flaky (empty) → 0.1.0.0
raw patch · 6 files changed
+295/−0 lines, 6 filesdep +basedep +retrydep +tagged
Dependencies added: base, retry, tagged, tasty, tasty-flaky, tasty-hunit
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- README.md +21/−0
- src/Test/Tasty/Flaky.hs +128/−0
- tasty-flaky.cabal +58/−0
- test/Main.hs +54/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for tasty-flaky++## 0.1.0.0 -- 2024-09-24++* First version
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2024, Laurent Rene de Cotret+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,21 @@+# `tasty-flaky`++This provides [`tasty`](https://hackage.haskell.org/package/tasty) integration for flaky tests, which are tests that are known to fail intermittently.++## Example usage++This package provides a single function, `flakyTest`, which can attach retrying logic to *any* test.+For example, you can retry test cases from [`tasty-hunit`](https://hackage.haskell.org/package/tasty-hunit) like so:++```haskell+import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit++myFlakyTest :: TestTree+myFlakyTest + = flakyTest (limitRetries 5 <> constantDelay 1000) + $ testCase "some test case" + $ do ... +```++In the example above, the test will be retried up to 5 times, with a delay of 1000 microseconds between tries,+if a failure occurs.
+ src/Test/Tasty/Flaky.hs view
@@ -0,0 +1,128 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+-- Module : $module+-- Copyright : (c) Powerweave Inc.+-- License : BSD-3-Clause+-- Maintainer : Laurent René de Cotret+-- Portability : portable+--+-- This module defines a single function, 'flakyTest', to declare a test+-- which intermittently fails. Flaky tests can be retries using retry policies+-- provided by the "Control.Retry" module (from the @retry@ package).+--+--+-- For example, you can retry test cases from @tasty-hunit@ like so:+--+-- @+-- import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit+-- +-- myFlakyTest :: TestTree+-- myFlakyTest = 'flakyTest' ('limitRetries' 5 <> 'constantDelay' 1000) $ testCase "some test case" $ do ... +-- @+--+-- In the example above, the test will be retried up to 5 times, with a delay of 1000 microseconds between tries,+-- if a failure occurs.+--+module Test.Tasty.Flaky (+ -- * Test wrapper+ flakyTest++ -- * Re-exports+ -- + -- | The following functions allow to construct 'RetryPolicyM IO' + -- from the "Control.Retry" module.+ , constantDelay+ , exponentialBackoff+ , fullJitterBackoff+ , fibonacciBackoff+ , limitRetries++ -- * Policy Transformers+ , limitRetriesByDelay+ , limitRetriesByCumulativeDelay+ , capDelay++) where++import Control.Retry hiding (RetryPolicy)+import Data.Functor ( (<&>) )+import Data.Tagged (Tagged, retag )+import Test.Tasty.Providers ( IsTest(..), Progress, Result, TestTree )+import Test.Tasty.Runners ( TestTree(..), Result(..), Progress(..), emptyProgress, resultSuccessful )+import Test.Tasty.Options ( OptionDescription, OptionSet )+++-- | A test tree of type @t@, with an associated retry policy+data FlakyTest t+ = MkFlakyTest (RetryPolicyM IO) t+++-- | Mark any test as flaky.+--+-- If this test is not successful, it will be retried according to the supplied @'RetryPolicyM' 'IO'@. +-- See "Control.Retry" for documentation on how to specify a @'RetryPolicyM' 'IO'@.+--+-- For example, you can retry test cases from @tasty-hunit@ like so:+--+-- @+-- import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit+-- +-- myFlakyTest :: TestTree+-- myFlakyTest = 'flakyTest' ('limitRetries' 5 <> 'constantDelay' 1000) $ testCase "some test case" $ do ... +-- @+--+flakyTest :: (RetryPolicyM IO) -> TestTree -> TestTree+flakyTest policy (SingleTest name t) = SingleTest name (MkFlakyTest policy t)+flakyTest policy (TestGroup name subtree) = TestGroup name (map (flakyTest policy) subtree)+flakyTest policy (PlusTestOptions modOption t) = PlusTestOptions modOption (flakyTest policy t)+flakyTest policy (WithResource spec f) = WithResource spec (f <&> flakyTest policy)+flakyTest policy (AskOptions f) = AskOptions $ \optionSet -> flakyTest policy (f optionSet)+flakyTest policy (After depType expr t) = After depType expr (flakyTest policy t)+++instance IsTest t => IsTest (FlakyTest t) where+ run :: IsTest t => OptionSet -> FlakyTest t -> (Progress -> IO ()) -> IO Result+ run opts (MkFlakyTest policy test) progressCallback = go defaultRetryStatus+ where+ -- The logic below mimics the `retry` package's Control.Retry.retrying+ -- with one major difference: we annotate the final result+ -- to report how many retries have been performed, regardless of+ -- the final result.+ go :: RetryStatus -> IO Result+ go status = do+ result <- run opts test progressCallback+ let consultPolicy policy' = do+ rs <- applyAndDelay policy' status+ case rs of+ -- We are done: no more retries+ Nothing -> pure $ annotateResult status result+ -- At least one more retry+ Just rs' -> do + progressCallback (annotateProgress status)+ go $! rs'++ if resultSuccessful result+ then pure $ annotateResult status result+ else consultPolicy policy+ + annotateProgress :: RetryStatus -> Progress+ annotateProgress status + -- Recall that `rsIterNumber` starts at 0, so the first attempt is rsIterNumber + 1+ = emptyProgress{progressText=mconcat ["Attempt #", show (rsIterNumber status + 1), " failed"]}+ + annotateResult :: RetryStatus -> Result -> Result+ annotateResult status result + = result { resultDescription = resultDescription result <> annotate status }+ where+ annotate :: RetryStatus -> String+ annotate (RetryStatus iternum cumdelay _) + | iternum == 0 = ""+ | otherwise = mconcat [" [", show iternum, " retries, ", show cumdelay, " μs delay]"]+++ testOptions :: Tagged (FlakyTest t) [OptionDescription]+ testOptions = retag (testOptions :: Tagged t [OptionDescription])
+ tasty-flaky.cabal view
@@ -0,0 +1,58 @@+cabal-version: 3.4+name: tasty-flaky+version: 0.1.0.0+synopsis: Handle flaky Tasty-based tests+description: Handle flaky Tasty-based tests, with configuration retry policies.+homepage: https://github.com/PowerweaveInc/tasty-flaky+license: BSD-3-Clause+license-file: LICENSE+author: Laurent René de Cotret+maintainer: laurent@powerweave.io+copyright: (c) Powerweave Inc.+category: Testing+build-type: Simple+tested-with: GHC ==9.10.1+ || ==9.8.2+ || ==9.6.6+ || ==9.4.8+ || ==9.2.8+ || ==9.0.2+ || ==8.10.7+extra-doc-files: CHANGELOG.md+ README.md+++source-repository head+ type: git+ location: https://github.com/PowerweaveInc/tasty-flaky.git+++common common-options+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wpartial-fields+ default-language: Haskell2010++library+ import: common-options+ exposed-modules: Test.Tasty.Flaky+ build-depends: base >=4.14 && <4.21+ , tagged >= 0.5 && <0.9+ , retry >= 0.7 && <0.10+ , tasty ^>=1.5+ hs-source-dirs: src++test-suite tasty-flaky-test+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base+ , tasty+ , tasty-flaky+ , tasty-hunit
+ test/Main.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE NumericUnderscores #-}+module Main (main) where++import Control.Monad ( unless )+import Control.Concurrent ( threadDelay )+import Data.IORef as IORef++import Test.Tasty ( TestTree, testGroup, defaultMain, withResource )+import Test.Tasty.Flaky ( limitRetries, flakyTest )+import Test.Tasty.HUnit ( testCase, assertFailure )+++main :: IO ()+main = defaultMain + $ testGroup "Test suite" + [ testSuccessOnFirstTry+ , testFlakyWithRetries+ , testFlakyWithRetriesProgressCallback+ ]+++testSuccessOnFirstTry :: TestTree+testSuccessOnFirstTry = flakyTest (limitRetries 0) $ testCase "succeeds on the first try" $ do+ pure ()+++-- This test will fail until the contents of the IORef is zero+testFlakyWithRetries :: TestTree+testFlakyWithRetries + = flakyTest (limitRetries 4) + $ withResource (IORef.newIORef (3 :: Int)) (const $ pure ()) + $ \getioref -> testCase "effectful" $ do+ ioref <- getioref+ n <- IORef.readIORef ioref+ unless (n == 0) $ do+ IORef.modifyIORef' ioref (\m -> m - 1)+ assertFailure "Not yet"+++-- This test will fail until the contents of the IORef is zero+testFlakyWithRetriesProgressCallback :: TestTree+testFlakyWithRetriesProgressCallback + = flakyTest (limitRetries 4) + $ withResource (IORef.newIORef (3 :: Int)) (const $ pure ()) + $ \getioref -> testCase "Showcasing progress report" $ do+ -- Wait 1 second for tasty to consider this test 'long-running'+ threadDelay 1_000_000+ ioref <- getioref+ n <- IORef.readIORef ioref+ unless (n == 0) $ do+ IORef.modifyIORef' ioref (\m -> m - 1)+ assertFailure "Not yet"++