sydtest 0.28.0.0 → 0.29.0.0

raw patch · 6 files changed

+69/−9 lines, 6 files

Files

• CHANGELOG.md +15/−0
• src/Test/Syd.hs +1/−0
• src/Test/Syd/Modify.hs +12/−0
• src/Test/Syd/Runner/Asynchronous.hs +29/−6
• src/Test/Syd/SpecDef.hs +11/−2
• sydtest.cabal +1/−1

@@ -1,5 +1,20 @@ # Changelog +## [0.29.0.0] - 2026-08-19++### Added++* `parallelWith`, to declare that at most a given number of the tests below it+  may run at once.  For tests that contend for something the suite does not+  own, such as one database server shared by a database per test, where running+  all of them at once is slower than running some of them and `sequential`+  gives up more than it needs to.++### Changed++* `Parallelism` has a third constructor, `ParallelWith`, so any exhaustive+  match on it needs a new case.+ ## [0.28.0.0] - 2026-08-08  ### Added

@@ -174,6 +174,7 @@     -- *** Declaring parallelism     sequential,     parallel,+    parallelWith,     withParallelism,     Parallelism (..), 

@@ -14,6 +14,7 @@     -- * Declaring parallelism     sequential,     parallel,+    parallelWith,     withParallelism,     Parallelism (..), @@ -79,6 +80,17 @@ -- | Declare that all tests below may be run in parallel. (This is the default.) parallel :: TestDefM a b c -> TestDefM a b c parallel = withParallelism Parallel++-- | Declare that at most this many of the tests below may run at once.+--+-- The bound is across everything below this point together, not per group, and+-- it does not add threads: it only ever holds tests back. Reach for it when+-- tests contend for something the suite does not own, such as one database+-- server shared by a database per test, where running all of them at once is+-- slower than running some of them and 'sequential' gives up more than it+-- needs to.+parallelWith :: Word -> TestDefM a b c -> TestDefM a b c+parallelWith = withParallelism . ParallelWith  -- | Annotate a test group with 'Parallelism'. withParallelism :: Parallelism -> TestDefM a b c -> TestDefM a b c

@@ -16,6 +16,7 @@  import Control.Concurrent.Async as Async import Control.Concurrent.MVar+import Control.Concurrent.QSem import Control.Concurrent.STM as STM import Control.Exception import Control.Monad@@ -239,11 +240,17 @@                   -- It's not enough to just not have two tests running at the                   -- same time, because they also need to be executed in order.                   case eParallelism of-                    Sequential -> do+                    RunSequential -> do                       waitForWorkersDone                       job 0-                    Parallel -> do+                    RunParallel -> do                       enqueueJob jobQueue job+                    RunParallelWith sem ->+                      -- Still queued like any other job, so this only ever+                      -- holds tests back; it never runs more of them than+                      -- there are workers.+                      enqueueJob jobQueue $ \workerNr ->+                        bracket_ (waitQSem sem) (signalQSem sem) (job workerNr)           DefPendingNode _ _ -> pure ()           DefDescribeNode _ sdf -> goForest sdf           DefSetupNode func sdf -> do@@ -298,9 +305,10 @@                               waitForWorkersDone                               func (eExternalResources e)                           )-          DefParallelismNode p' sdf ->+          DefParallelismNode p' sdf -> do+            runParallelism <- liftIO $ resolveParallelism p'             withReaderT-              (\e -> e {eParallelism = p'})+              (\e -> e {eParallelism = runParallelism})               (goForest sdf)           DefRandomisationNode _ sdf ->             goForest sdf -- Ignore, randomisation has already happened.@@ -324,7 +332,7 @@     runReaderT       (goForest handleForest)       Env-        { eParallelism = Parallel,+        { eParallelism = RunParallel,           eTimeout = settingTimeout settings,           eRetries = settingRetries settings,           eFlakinessMode = MayNotBeFlaky,@@ -333,11 +341,26 @@         }     waitForWorkersDone -- Make sure all jobs are done before cancelling the runners. +-- | 'Parallelism', with the semaphore a bound needs already made.+--+-- One semaphore per 'DefParallelismNode', so everything below that node shares+-- the one bound rather than each group getting its own.+data RunParallelism+  = RunParallel+  | RunParallelWith !QSem+  | RunSequential++resolveParallelism :: Parallelism -> IO RunParallelism+resolveParallelism = \case+  Parallel -> pure RunParallel+  ParallelWith w -> RunParallelWith <$> newQSem (fromIntegral w)+  Sequential -> pure RunSequential+ type R a = ReaderT (Env a) IO  -- Not exported, on purpose. data Env externalResources = Env-  { eParallelism :: !Parallelism,+  { eParallelism :: !RunParallelism,     eTimeout :: !Timeout,     eRetries :: !Word,     eFlakinessMode :: !FlakinessMode,

@@ -310,8 +310,17 @@       DefExpectationNode i sdf -> DefExpectationNode i $ goForest sdf  data Parallelism-  = Parallel-  | Sequential+  = -- | As many at once as there are threads to run them.+    Parallel+  | -- | At most this many at once, however many threads there are.+    --+    -- For tests that contend for something the test suite does not own, like+    -- one database server behind a database per test. Running fewer of those at+    -- once can be faster than running all of them, and is the smaller+    -- instrument where 'Sequential' would do.+    ParallelWith !Word+  | -- | One at a time.+    Sequential   deriving (Show, Eq, Generic)  data ExecutionOrderRandomisation

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