sydtest 0.18.0.1 → 0.19.0.0

raw patch · 12 files changed

+165/−13 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• src/Test/Syd.hs +5/−0
• src/Test/Syd/Def/Around.hs +1/−0
• src/Test/Syd/Modify.hs +18/−0
• src/Test/Syd/OptParse.hs +44/−0
• src/Test/Syd/Output.hs +1/−0
• src/Test/Syd/Runner/Asynchronous.hs +9/−0
• src/Test/Syd/Runner/Single.hs +44/−10
• src/Test/Syd/Runner/Synchronous/Interleaved.hs +8/−0
• src/Test/Syd/Runner/Synchronous/Separate.hs +10/−2
• src/Test/Syd/SpecDef.hs +11/−0
• sydtest.cabal +1/−1

@@ -1,5 +1,18 @@ # Changelog +## [0.19.0.0] - 2024-11-17++### Added++- Timeout support+- `modifiedTimeout`+- `withoutTimeout`+- `withTimeout`++### Changed++- Tests now timeout after 60 seconds by default.+ ## [0.18.0.1] - 2024-11-01  ### Changed

@@ -179,6 +179,11 @@     withExecutionOrderRandomisation,     ExecutionOrderRandomisation (..), +    -- *** Modifying the timeout+    modifyTimeout,+    withoutTimeout,+    withTimeout,+     -- *** Modifying the number of retries     modifyRetries,     withoutRetries,

@@ -215,6 +215,7 @@               DefAfterAllNode f sdf -> DefAfterAllNode f $ modifyForest sdf               DefParallelismNode f sdf -> DefParallelismNode f $ modifyForest sdf               DefRandomisationNode f sdf -> DefRandomisationNode f $ modifyForest sdf+              DefTimeoutNode f sdf -> DefTimeoutNode f $ modifyForest sdf               DefRetriesNode f sdf -> DefRetriesNode f $ modifyForest sdf               DefFlakinessNode f sdf -> DefFlakinessNode f $ modifyForest sdf               DefExpectationNode f sdf -> DefExpectationNode f $ modifyForest sdf

@@ -23,6 +23,11 @@     withExecutionOrderRandomisation,     ExecutionOrderRandomisation (..), +    -- * Modifying timeouts+    modifyTimeout,+    withoutTimeout,+    withTimeout,+     -- * Modifying the number of retries     modifyRetries,     withoutRetries,@@ -48,6 +53,7 @@ import Control.Monad.RWS.Strict import Test.QuickCheck.IO () import Test.Syd.Def+import Test.Syd.OptParse import Test.Syd.Run import Test.Syd.SpecDef @@ -89,6 +95,18 @@ -- | Annotate a test group with 'ExecutionOrderRandomisation'. withExecutionOrderRandomisation :: ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c withExecutionOrderRandomisation p = censor ((: []) . DefRandomisationNode p)++-- | Modify the test timeout+modifyTimeout :: (Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c+modifyTimeout modTimeout = censor ((: []) . DefTimeoutNode modTimeout)++-- | Turn off timeouts+withoutTimeout :: TestDefM a b c -> TestDefM a b c+withoutTimeout = modifyTimeout (const DoNotTimeout)++-- | Turn off timeouts+withTimeout :: Int -> TestDefM a b c -> TestDefM a b c+withTimeout i = modifyTimeout (const (TimeoutAfterMicros i))  -- | Modify the number of retries to use in flakiness diagnostics. modifyRetries :: (Word -> Word) -> TestDefM a b c -> TestDefM a b c

@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -56,6 +57,8 @@     settingFailFast :: !Bool,     -- | How many iterations to use to look diagnose flakiness     settingIterations :: !Iterations,+    -- | How many microseconds wait for a test to finish before considering it failed+    settingTimeout :: !Timeout,     -- | 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@@ -123,6 +126,7 @@                   )                   flagFailFast,               settingIterations = flagIterations,+              settingTimeout = flagTimeout,               settingRetries =                 fromMaybe                   ( if flagDebug@@ -152,12 +156,17 @@           settingFilters = mempty,           settingFailFast = False,           settingIterations = OneIteration,+          settingTimeout = TimeoutAfterMicros defaultTimeout,           settingRetries = defaultRetries,           settingFailOnFlaky = False,           settingReportProgress = ReportNoProgress,           settingProfile = False         } +-- 60 seconds+defaultTimeout :: Int+defaultTimeout = 60_000_000+ defaultRetries :: Word defaultRetries = 3 @@ -196,6 +205,7 @@     flagFailFast :: !(Maybe Bool),     flagIterations :: !Iterations,     flagRetries :: !(Maybe Word),+    flagTimeout :: !Timeout,     flagFailOnFlaky :: !Bool,     flagReportProgress :: !(Maybe ReportProgress),     flagDebug :: !Bool,@@ -293,6 +303,7 @@             name "fail-fast"           ]     flagIterations <- settingsParser+    flagTimeout <- settingsParser     flagRetries <-       optional $         setting@@ -322,6 +333,39 @@           value $ settingProfile defaultSettings         ]     pure Flags {..}++data Timeout+  = DoNotTimeout+  | TimeoutAfterMicros !Int+  deriving (Show, Read, Eq, Generic)++instance HasCodec Timeout where+  codec = dimapCodec f g codec+    where+      f = \case+        Nothing -> DoNotTimeout+        Just i -> TimeoutAfterMicros i+      g = \case+        DoNotTimeout -> Nothing+        TimeoutAfterMicros i -> Just i++instance HasParser Timeout where+  settingsParser =+    choice+      [ setting+          [ help "Don't timeout",+            switch DoNotTimeout,+            long "no-timeout"+          ],+        TimeoutAfterMicros+          <$> setting+            [ help "After how many microseconds to consider a test failed",+              reader auto,+              name "timeout",+              value defaultTimeout,+              metavar "MICROSECONDS"+            ]+      ]  data Threads   = -- | One thread

@@ -604,6 +604,7 @@       DefAroundAllWithNode _ sdf -> goF level sdf       DefAfterAllNode _ sdf -> goF level sdf       DefParallelismNode _ sdf -> goF level sdf+      DefTimeoutNode _ sdf -> goF level sdf       DefRetriesNode _ sdf -> goF level sdf       DefRandomisationNode _ sdf -> goF level sdf       DefFlakinessNode _ sdf -> goF level sdf

@@ -191,6 +191,7 @@                             noProgressReporter                             eExternalResources                             td+                            eTimeout                             eRetries                             eFlakinessMode                             eExpectationMode@@ -284,6 +285,10 @@               (goForest sdf)           DefRandomisationNode _ sdf ->             goForest sdf -- Ignore, randomisation has already happened.+          DefTimeoutNode modTimeout sdf ->+            withReaderT+              (\e -> e {eTimeout = modTimeout (eTimeout e)})+              (goForest sdf)           DefRetriesNode modRetries sdf ->             withReaderT               (\e -> e {eRetries = modRetries (eRetries e)})@@ -301,6 +306,7 @@       (goForest handleForest)       Env         { eParallelism = Parallel,+          eTimeout = settingTimeout settings,           eRetries = settingRetries settings,           eFlakinessMode = MayNotBeFlaky,           eExpectationMode = ExpectPassing,@@ -313,6 +319,7 @@ -- Not exported, on purpose. data Env externalResources = Env   { eParallelism :: !Parallelism,+    eTimeout :: !Timeout,     eRetries :: !Word,     eFlakinessMode :: !FlakinessMode,     eExpectationMode :: !ExpectationMode,@@ -381,6 +388,7 @@         DefAfterAllNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefTimeoutNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefRetriesNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefFlakinessNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefExpectationNode _ sdf -> fmap SubForestNode <$> goForest sdf@@ -442,6 +450,7 @@         DefAfterAllNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefParallelismNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefRandomisationNode _ sdf -> fmap SubForestNode <$> goForest sdf+        DefTimeoutNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefRetriesNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefFlakinessNode _ sdf -> fmap SubForestNode <$> goForest sdf         DefExpectationNode _ sdf -> fmap SubForestNode <$> goForest sdf

@@ -4,7 +4,9 @@  import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE+import System.Timeout (timeout) import Test.Syd.HList+import Test.Syd.OptParse import Test.Syd.Run import Test.Syd.SpecDef @@ -24,6 +26,8 @@       ((HList externalResources -> () -> t) -> t) ->       IO TestRunResult     ) ->+  -- | Timeout+  Timeout ->   -- | Max retries   Word ->   -- | Flakiness mode@@ -32,8 +36,8 @@   ExpectationMode ->   -- | Test result   IO TestRunReport-runSingleTestWithFlakinessMode progressReporter l td maxRetries fm em = do-  results <- runSingleTestWithRetries progressReporter l td maxRetries em+runSingleTestWithFlakinessMode progressReporter l td mTimeout maxRetries fm em = do+  results <- runSingleTestWithRetries progressReporter l td mTimeout maxRetries em   pure     TestRunReport       { testRunReportExpectationMode = em,@@ -53,24 +57,54 @@       ((HList externalResources -> () -> t) -> t) ->       IO TestRunResult     ) ->+  -- | Timeout+  Timeout ->   -- | 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+runSingleTestWithRetries progressReporter l td mTimeout maxRetries em = go maxRetries   where     go :: Word -> IO (NonEmpty TestRunResult)     go w-      | w <= 1 = (:| []) <$> runFunc+      | w <= 1 = (:| []) . either id id <$> runWithTimeout       | otherwise = do-          result <- runFunc-          if testStatusMatchesExpectationMode (testRunResultStatus result) em-            then pure (result :| [])-            else do-              rest <- go (pred w)-              pure (result NE.<| rest)+          mResult <- runWithTimeout+          case mResult of+            -- Don't retry on timeout+            Left result -> pure (result :| [])+            Right result ->+              if testStatusMatchesExpectationMode (testRunResultStatus result) em+                then pure (result :| [])+                else do+                  rest <- go (pred w)+                  pure (result NE.<| rest)       where+        runWithTimeout :: IO (Either TestRunResult TestRunResult)+        runWithTimeout = case mTimeout of+          DoNotTimeout -> Right <$> runFunc+          TimeoutAfterMicros micros -> do+            mResult <- timeout micros runFunc+            pure $ case mResult of+              Nothing -> Left timeoutResult+              Just result -> Right result+         runFunc :: IO TestRunResult         runFunc = testDefVal td progressReporter (\f -> f l ())++        timeoutResult :: TestRunResult+        timeoutResult =+          TestRunResult+            { testRunResultStatus = TestFailed,+              testRunResultException = Nothing,+              testRunResultNumTests = Nothing,+              testRunResultNumShrinks = Nothing,+              testRunResultFailingInputs = [],+              testRunResultLabels = Nothing,+              testRunResultClasses = Nothing,+              testRunResultTables = Nothing,+              testRunResultGoldenCase = Nothing,+              testRunResultExtraInfo = Just "Timeout!"+            }

@@ -87,6 +87,7 @@                   progressReporter                   eExternalResources                   td+                  eTimeout                   eRetries                   eFlakinessMode                   eExpectationMode@@ -155,6 +156,11 @@           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.+        DefTimeoutNode modTimeout sdf ->+          fmap SubForestNode+            <$> withReaderT+              (\e -> e {eTimeout = modTimeout (eTimeout e)})+              (goForest sdf)         DefRetriesNode modRetries sdf ->           fmap SubForestNode             <$> withReaderT@@ -179,6 +185,7 @@           (goForest testForest)           Env             { eLevel = 0,+              eTimeout = settingTimeout settings,               eRetries = settingRetries settings,               eFlakinessMode = MayNotBeFlaky,               eExpectationMode = ExpectPassing,@@ -205,6 +212,7 @@ -- Not exported, on purpose. data Env externalResources = Env   { eLevel :: Int,+    eTimeout :: !Timeout,     eRetries :: !Word,     eFlakinessMode :: !FlakinessMode,     eExpectationMode :: !ExpectationMode,

@@ -23,7 +23,8 @@     <$> runReaderT       (goForest testForest)       Env-        { eRetries = settingRetries settings,+        { eTimeout = settingTimeout settings,+          eRetries = settingRetries settings,           eFlakinessMode = MayNotBeFlaky,           eExpectationMode = ExpectPassing,           eExternalResources = HNil@@ -50,6 +51,7 @@                 noProgressReporter                 eExternalResources                 td+                eTimeout                 eRetries                 eFlakinessMode                 eExpectationMode@@ -113,6 +115,11 @@         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.+      DefTimeoutNode modTimeout sdf ->+        fmap SubForestNode+          <$> withReaderT+            (\e -> e {eTimeout = modTimeout (eTimeout e)})+            (goForest sdf)       DefRetriesNode modRetries sdf ->         fmap SubForestNode           <$> withReaderT@@ -133,7 +140,8 @@  -- Not exported, on purpose. data Env externalResources = Env-  { eRetries :: !Word,+  { eTimeout :: !Timeout,+    eRetries :: !Word,     eFlakinessMode :: !FlakinessMode,     eExpectationMode :: !ExpectationMode,     eExternalResources :: !(HList externalResources)

@@ -127,6 +127,11 @@     ExecutionOrderRandomisation ->     SpecDefForest outers inner extra ->     SpecDefTree outers inner extra+  DefTimeoutNode ::+    -- | Modify the timeout setting+    (Timeout -> Timeout) ->+    SpecDefForest outers inner extra ->+    SpecDefTree outers inner extra   DefRetriesNode ::     -- | Modify the number of retries     (Word -> Word) ->@@ -161,6 +166,7 @@           DefAfterAllNode func sdf -> DefAfterAllNode func $ goF sdf           DefParallelismNode p sdf -> DefParallelismNode p $ goF sdf           DefRandomisationNode p sdf -> DefRandomisationNode p $ goF sdf+          DefTimeoutNode p sdf -> DefTimeoutNode p $ goF sdf           DefRetriesNode p sdf -> DefRetriesNode p $ goF sdf           DefFlakinessNode p sdf -> DefFlakinessNode p $ goF sdf           DefExpectationNode p sdf -> DefExpectationNode p $ goF sdf@@ -183,6 +189,7 @@           DefAfterAllNode _ sdf -> goF sdf           DefParallelismNode _ sdf -> goF sdf           DefRandomisationNode _ sdf -> goF sdf+          DefTimeoutNode _ sdf -> goF sdf           DefRetriesNode _ sdf -> goF sdf           DefFlakinessNode _ sdf -> goF sdf           DefExpectationNode _ sdf -> goF sdf@@ -205,6 +212,7 @@           DefAfterAllNode func sdf -> DefAfterAllNode func <$> goF sdf           DefParallelismNode p sdf -> DefParallelismNode p <$> goF sdf           DefRandomisationNode p sdf -> DefRandomisationNode p <$> goF sdf+          DefTimeoutNode p sdf -> DefTimeoutNode p <$> goF sdf           DefRetriesNode p sdf -> DefRetriesNode p <$> goF sdf           DefFlakinessNode p sdf -> DefFlakinessNode p <$> goF sdf           DefExpectationNode p sdf -> DefExpectationNode p <$> goF sdf@@ -243,6 +251,7 @@       DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest dl sdf       DefParallelismNode func sdf -> DefParallelismNode func <$> goForest dl sdf       DefRandomisationNode func sdf -> DefRandomisationNode func <$> goForest dl sdf+      DefTimeoutNode func sdf -> DefTimeoutNode 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@@ -265,6 +274,7 @@       DefAroundAllWithNode func sdf -> DefAroundAllWithNode func <$> goForest sdf       DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest sdf       DefParallelismNode func sdf -> DefParallelismNode func <$> goForest sdf+      DefTimeoutNode i sdf -> DefTimeoutNode i <$> goForest sdf       DefRetriesNode i sdf -> DefRetriesNode i <$> goForest sdf       DefFlakinessNode i sdf -> DefFlakinessNode i <$> goForest sdf       DefExpectationNode i sdf -> DefExpectationNode i <$> goForest sdf@@ -292,6 +302,7 @@       DefAroundAllWithNode func sdf -> DefAroundAllWithNode func $ goForest sdf       DefAfterAllNode func sdf -> DefAfterAllNode func $ goForest sdf       DefParallelismNode func sdf -> DefParallelismNode func $ goForest sdf+      DefTimeoutNode i sdf -> DefTimeoutNode i $ goForest sdf       DefRetriesNode i sdf -> DefRetriesNode i $ goForest sdf       DefFlakinessNode i sdf -> DefFlakinessNode i $ goForest sdf       DefRandomisationNode eor sdf -> DefRandomisationNode eor (goForest sdf)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sydtest-version:        0.18.0.1+version:        0.19.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