sydtest 0.27.2.0 → 0.29.0.0

raw patch · 8 files changed

Files

• CHANGELOG.md +30/−0
• Setup.hs +2/−0
• src/Test/Syd.hs +2/−0
• src/Test/Syd/Def/Scenario.hs +50/−9
• src/Test/Syd/Modify.hs +12/−0
• src/Test/Syd/Runner/Asynchronous.hs +29/−6
• src/Test/Syd/SpecDef.hs +11/−2
• sydtest.cabal +2/−2

@@ -1,5 +1,35 @@ # 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++* `scenarioDirOfDirs`, for scenarios that consist of more than one file.  It+  defines a test for each subdirectory of the given directory, and hands that+  subdirectory to the test definition.++### Changed++* `scenarioDir` and `scenarioDirRecur` now define a single failing test when+  they find no files, instead of defining no tests at all.  An empty scenario+  directory usually means the scenario files were omitted by accident, for+  example because they were not packaged in `extra-source-files`.+ ## [0.27.2.0] - 2026-07-16  ### Changed

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -87,6 +87,7 @@     -- ** Scenario tests     scenarioDir,     scenarioDirRecur,+    scenarioDirOfDirs,      -- ** Expectations     shouldBe,@@ -173,6 +174,7 @@     -- *** Declaring parallelism     sequential,     parallel,+    parallelWith,     withParallelism,     Parallelism (..), 

@@ -1,4 +1,4 @@-module Test.Syd.Def.Scenario (scenarioDir, scenarioDirRecur) where+module Test.Syd.Def.Scenario (scenarioDir, scenarioDirRecur, scenarioDirOfDirs) where  import Control.Monad import Control.Monad.IO.Class@@ -8,9 +8,17 @@ import qualified System.FilePath as FP import Test.Syd.Def.Specify import Test.Syd.Def.TestDefM+import Test.Syd.Expectation  -- | Define a test for each file in the given directory. --+-- Subdirectories are ignored, use 'scenarioDirRecur' to descend into them or+-- 'scenarioDirOfDirs' to treat each of them as a scenario.+--+-- If the directory is empty or absent, this defines a single failing test+-- instead, because that usually means the scenario files were omitted by+-- accident.+-- -- Example: -- -- >   scenarioDir "test_resources/even" $ \fp ->@@ -19,10 +27,14 @@ -- >       n <- readIO s -- >       (n :: Int) `shouldSatisfy` even scenarioDir :: FilePath -> (FilePath -> TestDefM outers inner ()) -> TestDefM outers inner ()-scenarioDir = scenarioDirHelper listDirRel+scenarioDir = scenarioDirHelper "files" (fmap (map fromRelFile . snd) . listDirRel)  -- | Define a test for each file in the given directory, recursively. --+-- If the directory contains no files, or is absent, this defines a single+-- failing test instead, because that usually means the scenario files were+-- omitted by accident.+-- -- Example: -- -- >   scenarioDirRecur "test_resources/odd" $ \fp ->@@ -31,17 +43,46 @@ -- >       n <- readIO s -- >       (n :: Int) `shouldSatisfy` odd scenarioDirRecur :: FilePath -> (FilePath -> TestDefM outers inner ()) -> TestDefM outers inner ()-scenarioDirRecur = scenarioDirHelper listDirRecurRel+scenarioDirRecur = scenarioDirHelper "files" (fmap (map fromRelFile . snd) . listDirRecurRel) +-- | Define a test for each subdirectory of the given directory.+--+-- Use this when a single scenario consists of more than one file.  Files in+-- the given directory itself are ignored, and so is any nesting below the+-- subdirectories: each subdirectory is one scenario, whatever it contains.+--+-- If there are no subdirectories, or the directory is absent, this defines a+-- single failing test instead, because that usually means the scenarios were+-- omitted by accident.+--+-- Example:+--+-- >   scenarioDirOfDirs "test_resources/same" $ \fp ->+-- >     it "contains two files with the same contents" $ do+-- >       a <- readFile (fp </> "a")+-- >       b <- readFile (fp </> "b")+-- >       a `shouldBe` b+scenarioDirOfDirs :: FilePath -> (FilePath -> TestDefM outers inner ()) -> TestDefM outers inner ()+scenarioDirOfDirs =+  scenarioDirHelper+    "directories"+    (fmap (map (FP.dropTrailingPathSeparator . fromRelDir) . fst) . listDirRel)+ scenarioDirHelper ::-  (Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])) ->+  -- | What the lister looks for, for the description of the failing test that+  -- an empty scenario directory produces.+  String ->+  -- | The scenarios, relative to the given directory+  (Path Abs Dir -> IO [FilePath]) ->   FilePath ->   (FilePath -> TestDefM outers inner ()) ->   TestDefM outers inner ()-scenarioDirHelper lister dp func =+scenarioDirHelper noun lister dp func =   describe dp $ do     ad <- liftIO $ resolveDir' dp-    fs <- liftIO $ fmap (fromMaybe []) $ forgivingAbsence $ snd <$> lister ad-    forM_ fs $ \rf -> do-      let fp = dp FP.</> fromRelFile rf-      describe (fromRelFile rf) $ func fp+    ss <- liftIO $ fmap (fromMaybe []) $ forgivingAbsence $ lister ad+    if null ss+      then it (unwords ["has scenario", noun]) $ \_ ->+        (expectationFailure $ unwords ["No scenario", noun, "found in", dp] :: IO ())+      else forM_ ss $ \s ->+        describe s $ func (dp FP.</> s)

@@ -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.27.2.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@@ -93,7 +93,7 @@     , safe-coloured-text     , stm     , svg-builder-    , sydtest-mutation-runtime+    , sydtest-mutation-runtime >=0.1     , text     , transformers     , vector