tasty-bdd 0.1.0.2 → 0.2.0.0
raw patch · 15 files changed
+530/−56 lines, 15 filesdep +stmPVP ok
version bump matches the API change (PVP)
Dependencies added: stm
API changes (from Hackage documentation)
- Test.BDD.Language: when :: Functor f => (m t -> f (m t)) -> BDDTest m t q -> f (BDDTest m t q)
+ Test.BDD.Language: whenAction :: Functor f => (m t -> f (m t)) -> BDDTest m t q -> f (BDDTest m t q)
Files
- CHANGELOG.md +11/−2
- README.md +1/−1
- docs/api.md +2/−2
- docs/development.md +1/−1
- docs/releases.md +17/−5
- docs/stories/scenarios.md +8/−5
- specs/001-modernization/tasks.md +2/−0
- src/Test/BDD/Language.hs +9/−5
- src/Test/BDD/LanguageFree.hs +13/−1
- src/Test/Tasty/Bdd.hs +50/−15
- tasty-bdd.cabal +12/−6
- tests/ControlMonadImport.hs +49/−0
- tests/Main.hs +4/−0
- tests/TeardownSafety.hs +309/−0
- tools/check-api.sh +42/−13
CHANGELOG.md view
@@ -1,7 +1,16 @@ # Changelog -## 0.1.0.2 — release candidate+## 0.2.0.0 — published 2026-10-01 +- Breaking: `Test.BDD.Language` exports the lens over the action of `BDDTest` as `whenAction` instead of `when`, with the same type, so the module can be imported unqualified next to `Control.Monad`. The record field `_when` is unchanged.+- Release every resource acquired with `GivenAndAfter`, `givenAndAfter` or `givenAndAfter_` when a scenario fails by any exception, in reverse acquisition order. A constructor scenario whose acquisition throws releases the resources acquired before it.+- Run the remaining teardowns when one throws. A failed scenario keeps its own failure as the reported reason; a scenario whose steps pass but whose teardown throws is reported failed.+- Fail-fast is unchanged: with it on, a failed constructor scenario still skips teardown.++Migrating from 0.1: replace each use of the lens `when` with `whenAction`, for example `view when test` becomes `view whenAction test`. A module that hid the lens to use `Control.Monad.when`, such as `import Test.BDD.Language hiding (when)`, can drop the `hiding` clause.++## 0.1.0.2 — published+ - Verify GHC 9.12.3 support and migrate development from Stack/hpack to Cabal 3.0 and a locked Nix build. - Point package homepage, source repository and issue links to `lambdasistemi/tasty-bdd` following the repository transfer. - Bound dependencies and add executable build, package, formatting, lint, documentation and source-archive checks.@@ -11,7 +20,7 @@ - Deploy MkDocs to GitHub Pages and verify the served commit and generated bytes. - Preserve the public API and published 0.1.0.1 behavior, including the `Succeded` spelling and dependency-wrapper traversal fix. -This candidate has not been uploaded to Hackage or tagged as a release. Fresh compiler evidence covers GHC 9.12.3; older compilers allowed by dependency bounds have not been revalidated.+Uploaded to [Hackage](https://hackage.haskell.org/package/tasty-bdd-0.1.0.2) with documentation on 2026-10-01 and tagged `v0.1.0.2`. Fresh compiler evidence covers GHC 9.12.3; older compilers allowed by dependency bounds have not been revalidated. ## 0.1.0.1 — published
README.md view
@@ -39,6 +39,6 @@ ## Published package -[Hackage](https://hackage.haskell.org/package/tasty-bdd) carries 0.1.0.0 and 0.1.0.1. GitLab history through January 2025 is retained here, including the source published in 0.1.0.1. This modernization has not published a new package. See [release preparation](docs/releases.md).+[Hackage](https://hackage.haskell.org/package/tasty-bdd) carries 0.1.0.0, 0.1.0.1, 0.1.0.2 and 0.2.0.0. GitLab history through January 2025 is retained here, including the source published in 0.1.0.1. [Version 0.1.0.2](https://hackage.haskell.org/package/tasty-bdd-0.1.0.2) was uploaded with documentation on 2026-10-01 and is tagged `v0.1.0.2`. [Version 0.2.0.0](https://hackage.haskell.org/package/tasty-bdd-0.2.0.0), uploaded on 2026-10-01 and tagged `v0.2.0.0`, renames the `when` lens to `whenAction` and releases resources when a scenario fails by exception; see the [changelog](CHANGELOG.md). See [how releases are prepared and published](docs/releases.md). Licensed under [BSD-3-Clause](LICENSE).
docs/api.md view
@@ -2,7 +2,7 @@ ## Find the types and functions for your scenario -As a test author, you can browse the exact API rendering built for the current Hackage release candidate. Choose a module below, or use the symbol index inside the reference.+As a test author, you can browse the exact API rendering that the Hackage release check builds from this source. Choose a module below, or use the symbol index inside the reference. - <a href="../haddock/Test-Tasty-Bdd.html" target="bdd-api">Tasty integration and decorators</a> - <a href="../haddock/Test-BDD-Language.html" target="bdd-api">Typed constructor DSL and lenses</a>@@ -21,7 +21,7 @@ flowchart LR Source -->|package and test| Archive Archive -->|render and verify coverage| Haddock- Haddock -->|bundle| HackageCandidate+ Haddock -->|bundle for upload| HackageDocs Haddock -->|embed same rendering| Documentation Documentation -->|verify served bytes| Pages ```
docs/development.md view
@@ -23,7 +23,7 @@ Flake -->|evidence| PR ``` -The flake's `unit`, `format-check`, `hlint`, `cabal-check`, `workflow-check`, `api-compat`, `hackage-quality` and `docs` apps provide focused checks. `api-compat` loads all four modules from the hash-pinned Hackage 0.1.0.1 source and this checkout under the same GHC, then compares their exported types, constructors, roles and signatures, including `onEach`. The runtime suite separately checks traversal through resources, options, groups and dependencies. This is a source-API check on the locked compiler, not a binary-ABI or full dependency-range guarantee. `nix build .#docs` produces the strict MkDocs site. No Hackage credentials are needed.+The flake's `unit`, `format-check`, `hlint`, `cabal-check`, `workflow-check`, `api-compat`, `hackage-quality` and `docs` apps provide focused checks. `api-compat` loads all four modules from the hash-pinned Hackage 0.1.0.1 source and this checkout under the same GHC, then compares their exported types, constructors, roles and signatures, including `onEach`. Each module is browsed in its own GHCi session. The only accepted difference from 0.1.0.1 is the lens over the action of `BDDTest`: 0.1.0.1 exports it from `Test.BDD.Language` as `when`, 0.2.0.0 as `whenAction` with the same type. The check applies exactly that rename to the baseline and fails when the baseline lens is not found once, or on any other difference, including `when` still exported. The runtime suite separately checks traversal through resources, options, groups and dependencies. This is a source-API check on the locked compiler, not a binary-ABI or full dependency-range guarantee. `nix build .#docs` produces the strict MkDocs site. No Hackage credentials are needed. ## Specify a change
docs/releases.md view
@@ -1,4 +1,4 @@-# Prepare a release+# Prepare and publish a release ## Review a package before publication @@ -6,12 +6,24 @@ ```mermaid flowchart LR- Checks -->|pass| SourceArchive- SourceArchive -->|review contents and rebuild| Maintainer- Maintainer -->|separate future decision| Release+ Checks -->|pass| Archives+ Archives -->|review contents and rebuild| Maintainer+ Maintainer -->|upload source and documentation| Hackage+ Maintainer -->|tag released commit| Tag ``` -Run `nix develop --accept-flake-config -c just release-check` to create checked source and Hackage-mode Haddock archives plus `SHA256SUMS` in `result-release`. The prepared candidate is version 0.1.0.2. The `hackage-quality` gate unpacks the source archive, runs `cabal check`, builds and tests with the consumer warning policy, and requires 100% Haddock coverage for every module with no unresolved local references. It runs offline against the locked dependency environment and is required by CI. The source archive and Haddock bundle are review artifacts; preparing them does not publish a package.+Run `nix develop --accept-flake-config -c just release-check` to create checked source and Hackage-mode Haddock archives plus `SHA256SUMS` in `result-release`. The `hackage-quality` gate unpacks the source archive, runs `cabal check`, builds and tests with the consumer warning policy, and requires 100% Haddock coverage for every module with no unresolved local references. It runs offline against the locked dependency environment and is required by CI. Building the archives does not publish a package; publication is a manual upload of those archives.++## How 0.1.0.2 was published++Version 0.1.0.2 was uploaded to [Hackage](https://hackage.haskell.org/package/tasty-bdd-0.1.0.2) on 2026-10-01 with documentation.++- Both archives are the outputs of `nix build .#hackage-release`, the build `just release-check` runs.+- The source archive was uploaded with `cabal upload --publish` and the documentation archive with `cabal upload --publish -d`.+- The sha256 of the uploaded tarball, `2c8170f6f7e3279a968745ece3e988a3f8f38718db9ddf0f34844dd4cec5dbf3`, equals the `SHA256SUMS` entry of the local build.+- The annotated tag `v0.1.0.2` points at commit 0836274.++## Hackage links and automation Repository ownership does not change Hackage ownership or existing package descriptions. Hackage 0.1.0.1 currently points to GitLab. A GitHub transfer alone will not update those links. Existing Hackage tarballs remain historical artifacts.
docs/stories/scenarios.md view
@@ -19,7 +19,7 @@ ## Set up and tear down resources -`givenAndAfter` returns both a value for later steps and a resource for teardown. `givenAndAfter_` acquires a resource only for teardown. Teardowns run in reverse acquisition order.+As a test author whose scenario holds real resources — a server, a temporary directory, a database connection — you want every one of them released however the scenario ends. `givenAndAfter` returns both a value for later steps and a resource for teardown. `givenAndAfter_` acquires a resource only for teardown. With the constructor language, `GivenAndAfter` does the same. Teardowns run in reverse acquisition order. ```mermaid sequenceDiagram@@ -28,9 +28,12 @@ participant B as Resource B S->>A: acquire S->>B: acquire- S->>S: action and assertions- S->>B: release- S->>A: release+ S->>S: action and assertions, pass or fail+ S->>B: release, even after a failure+ S->>A: release, even if B's release threw+ Note over S: reports the step's failure, else a release failure ``` -The free provider runs recorded teardown on success and caught failure. The constructor provider's fail-fast mode intentionally skips teardown after its equality failure. These existing behaviors differ; choose deliberately. Neither API promises exception-safe resource management for every possible asynchronous exception.+Both providers release every acquired resource whether the scenario passes, fails an equality assertion, or fails because its action or an assertion throws. When an acquisition throws, the resources acquired before it are released and the scenario fails with the acquisition's exception. A release that throws does not stop the remaining releases. A failed scenario keeps its own failure as the reported reason, even when a release also throws; a scenario whose steps pass but whose release throws is reported failed.++With fail-fast on, the constructor provider skips teardown after a failed scenario, so its resources stay in place for inspection; a passing scenario still releases them. The free provider ignores the fail-fast option. Releases are not masked: neither API promises exception-safe resource management for every possible asynchronous exception.
specs/001-modernization/tasks.md view
@@ -28,3 +28,5 @@ - [x] Push the reviewed branch and record CI status and remaining operator steps. The modernization is pushed to [PR 3](https://github.com/lambdasistemi/tasty-bdd/pull/3). Local checkout/archive gates pass; GitHub CI is tracked on the PR and is not implied green by local results. The authorized ownership transfer is complete and the wiki is published. The operator subsequently requested candidate 0.1.0.2 preparation. PR acceptance and publication remain maintainer steps.++Follow-up: 0.1.0.2 was published on Hackage on 2026-10-01 and tagged `v0.1.0.2`; see the [release page](../../docs/releases.md).
src/Test/BDD/Language.hs view
@@ -41,7 +41,7 @@ , BDDTest (..) , TestContext (..) , context- , when+ , whenAction , tests , interpret , Phase (..)@@ -108,13 +108,17 @@ -> f (BDDTest m t q2) tests f (BDDTest ts c w) = (\ts' -> BDDTest ts' c w) <$> f ts --- | Lens for the action whose result is supplied to the assertions.-when+{- | Lens for the action whose result is supplied to the assertions.++Named @whenAction@ so that it can be imported unqualified next to+@Control.Monad.when@.+-}+whenAction :: (Functor f) => (m t -> f (m t)) -> BDDTest m t q -> f (BDDTest m t q)-when f (BDDTest ts c w) = BDDTest ts c <$> f w+whenAction f (BDDTest ts c w) = BDDTest ts c <$> f w -- | Preparing language types type BDDPreparing m t q = Language m t q 'Preparing@@ -130,7 +134,7 @@ over context ((:) $ TestContext given after) $ interpret p interpret (When fa p) =- set when fa $ interpret p+ set whenAction fa $ interpret p interpret (Then ca p) = over tests (ca :) $ interpret p interpret End = BDDTest [] [] $
src/Test/BDD/LanguageFree.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -75,6 +76,17 @@ stepIn :: (MonadCatch m) => m a -> (a -> CJR m) -> CJR m stepIn g q = catchCJR (lift g >>= q) +{- | Run a teardown, then the remaining ones even when it throws; the+first exception is rethrown once all have run.+-}+releaseThen :: (MonadCatch m) => m () -> m () -> m ()+releaseThen release rest =+ try release >>= \case+ Right () -> rest+ Left (e :: SomeException) -> do+ (_ :: Either SomeException ()) <- try rest+ throwM e+ interpret :: forall m. (MonadCatch m) => Language m 'Preparing -> m (BDDResult m) interpret y = runReaderT (interpret' y) (return ())@@ -82,7 +94,7 @@ interpret' :: Language m 'Preparing -> CJR m interpret' (Given g p) = stepIn g $ interpret' . p interpret' (GivenAndAfter g z p) =- stepIn g $ \(x, r) -> local (z r >>) $ interpret' $ p x+ stepIn g $ \(x, r) -> local (releaseThen $ z r) $ interpret' $ p x interpret' (When fa p) = stepIn fa $ \x -> interpretT' x p interpret' (And f g) = do
src/Test/Tasty/Bdd.hs view
@@ -43,12 +43,15 @@ ) where +import Control.Monad (foldM) import Control.Monad.Catch ( Exception (..) , MonadCatch (..) , MonadThrow (..)+ , catchAll ) import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Maybe (fromMaybe, isNothing) import Data.Tagged (Tagged (..)) import Data.TreeDiff import Data.Typeable (Proxy (..), Typeable)@@ -85,7 +88,7 @@ run _ (FreeBDDCase rc test) _ = rc $ test >>= g where g (Failed e td) = do- td+ td `catchAll` const (return ()) maybe (throwM e) (return . testFailed . testFailMessage)@@ -106,28 +109,60 @@ => IsTest (BDDTest m t ()) where run os (BDDTest ts rup w) f = runCase $ do- teardowns <-- sequence_ . reverse <$> mapM (\(TestContext g a) -> a <$> g) rup- resultOfWhen <- w- let loop [] = return Nothing- loop (then' : xs) = do+ (teardowns, acquisitionFailure) <- acquireAll rup+ outcome <- case acquisitionFailure of+ Just rethrow -> return $ Left rethrow+ Nothing -> (Right <$> (w >>= loop)) `catchAll` (return . Left . throwM)+ let stepsPassed = either (const False) isNothing outcome+ teardownFailure <- case lookupOption os of+ FailFast True | not stepsPassed -> return Nothing+ _ -> releaseAll teardowns+ case (outcome, teardownFailure) of+ (Left rethrow, _) -> rethrow+ (Right (Just reason), _) -> return $ testFailed reason+ (Right Nothing, Just rethrow) -> rethrow+ (Right Nothing, Nothing) -> return $ testPassed ""+ where+ loop resultOfWhen = go ts+ where+ go [] = return Nothing+ go (then' : xs) = do liftIO $ f ( Progress "" (fromIntegral (length xs) / fromIntegral (length ts)) )- (then' resultOfWhen >> loop xs)+ (then' resultOfWhen >> go xs) `catch` (\(EqualityDoesntHold e) -> return (Just e))- resultOfThen <- loop ts- case resultOfThen of- Just reason -> do- case lookupOption os of- FailFast False -> teardowns- _ -> return ()- return $ testFailed reason- Nothing -> teardowns >> return (testPassed "") testOptions = Tagged [Option (Proxy :: Proxy FailFast)]++{- | Run the acquisitions in order, stopping at the first that throws.+Returns the teardowns of the acquired resources, most recent first, and,+if an acquisition threw, the action rethrowing its exception.+-}+acquireAll+ :: (MonadCatch m)+ => [TestContext m]+ -> m ([m ()], Maybe (m Result))+acquireAll = go []+ where+ go held [] = return (held, Nothing)+ go held (TestContext g a : cs) = do+ acquired <- (Right <$> g) `catchAll` (return . Left . throwM)+ case acquired of+ Left rethrow -> return (held, Just rethrow)+ Right r -> go (a r : held) cs++{- | Run every teardown in order, even when one throws. Returns the action+rethrowing the exception of the first teardown that threw, if any.+-}+releaseAll :: (MonadCatch m) => [m ()] -> m (Maybe (m Result))+releaseAll = foldM release Nothing+ where+ release first td =+ (td >> return first)+ `catchAll` \e -> return $ Just $ fromMaybe (throwM e) first -- | show a coloured difference of 2 values prettyDifferences :: (ToExpr a) => a -> a -> String
tasty-bdd.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: tasty-bdd-version: 0.1.0.2+version: 0.2.0.0 synopsis: BDD tests language and tasty provider description: A typed Given/When/Then language and a free-monad interface for Tasty,@@ -84,14 +84,20 @@ import: warnings type: exitcode-stdio-1.0 main-is: Main.hs+ other-modules:+ ControlMonadImport+ TeardownSafety+ hs-source-dirs: tests build-depends:- , base >=4.7 && <5- , HUnit >=1.6 && <1.7- , tasty >=1.2 && <1.6+ , base >=4.7 && <5+ , HUnit >=1.6 && <1.7+ , stm >=2.5 && <2.6+ , tasty >=1.2 && <1.6 , tasty-bdd- , tasty-expected-failure >=0.12 && <0.13- , tasty-hunit >=0.10 && <0.11+ , tasty-expected-failure >=0.12 && <0.13+ , tasty-fail-fast >=0.0.3 && <0.1+ , tasty-hunit >=0.10 && <0.11 test-suite example import: warnings
+ tests/ControlMonadImport.hs view
@@ -0,0 +1,49 @@+{- |+Module : ControlMonadImport+Copyright : (c) Paolo Veronelli 2026+License : BSD-3-Clause++A scenario module imports "Test.BDD.Language" and "Control.Monad" together,+unqualified, and uses 'when' as the monadic conditional. The module itself+is the proof: it compiles only while the language exports no name that+clashes with "Control.Monad".+-}+module ControlMonadImport (controlMonadImportTests) where++import Control.Monad+import Data.Functor.Const (Const (..))+import Data.Functor.Identity (Identity (..))+import Data.IORef (modifyIORef, newIORef, readIORef)+import Test.BDD.Language+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++-- | 'when' and 'whenAction' used side by side in one scenario module.+controlMonadImportTests :: TestTree+controlMonadImportTests =+ testGroup+ "Test.BDD.Language imported next to Control.Monad"+ [ testCase "when is the monadic conditional inside a scenario action" $ do+ seen <- newIORef []+ let+ action = do+ forM_ [1 .. 4 :: Int] $ \i ->+ when (even i) $ modifyIORef seen (i :)+ pure "done"+ result <- _when $ scenario action+ result @?= "done"+ readIORef seen >>= (@?= [4, 2])+ , testCase "whenAction reads and replaces the action of a scenario" $ do+ getConst (whenAction Const $ scenario $ pure "first")+ >>= (@?= "first")+ let+ replaced =+ runIdentity $+ whenAction+ (const $ Identity $ pure "second")+ (scenario $ pure "first")+ _when replaced >>= (@?= "second")+ ]+ where+ scenario :: IO String -> BDDTest IO String ()+ scenario action = interpret $ When action $ Then (\_ -> pure ()) End
tests/Main.hs view
@@ -5,6 +5,8 @@ import Control.Concurrent.MVar import Control.Exception+import ControlMonadImport (controlMonadImportTests)+import TeardownSafety (teardownSafetyTests) import Test.BDD.LanguageFree import qualified Test.HUnit as H import Test.Tasty hiding (after)@@ -188,6 +190,8 @@ testTest t ([10, 0, 1, 0, 2, 11] :: [Int]) , expectFail $ testBehaviorF runCase "didn't break tasty" $ do when_ (pure 42 :: IO Int) $ then_ $ \x -> x @?= 43+ , teardownSafetyTests+ , controlMonadImportTests ] testTest :: (Show a, Eq a) => ((a -> IO ()) -> IO ()) -> [a] -> IO ()
+ tests/TeardownSafety.hs view
@@ -0,0 +1,309 @@+{-# LANGUAGE LambdaCase #-}++{- |+Module : TeardownSafety+Copyright : (c) Paolo Veronelli 2026+License : BSD-3-Clause++Every resource acquired by a scenario is released however the scenario+fails. Each scenario runs through tasty's own 'launchTestTree'; the tests+assert the exact list of released resources, in release order, and the+result tasty reports.+-}+module TeardownSafety (teardownSafetyTests) where++import Control.Concurrent.STM (atomically, readTVar, retry)+import Control.Exception (throwIO)+import Data.Foldable (toList)+import Data.IORef (modifyIORef, newIORef, readIORef)+import Data.List (isInfixOf)+import Test.BDD.LanguageFree (givenAndAfter_, then_, when_)+import qualified Test.HUnit as H+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.Bdd+ ( Language (..)+ , testBehavior+ , testBehaviorF+ , (@?=)+ )+import Test.Tasty.HUnit (assertFailure, testCase)+import Test.Tasty.Ingredients.FailFast (FailFast (..))+import Test.Tasty.Options (OptionSet, setOption)+import Test.Tasty.Runners+ ( Outcome (..)+ , Result (..)+ , Status (..)+ , launchTestTree+ )++-- | Records the name of a resource when its teardown runs.+type Release = String -> IO ()++-- | A teardown that records the resource, then throws.+throwingRelease :: Release -> String -> IO ()+throwingRelease release r = do+ release r+ throwIO $ userError $ "teardown " ++ r++{- | Run a single-test tree with tasty and return the released resources,+in release order, with the result tasty reports for the test.+-}+observe :: OptionSet -> (Release -> TestTree) -> IO ([String], Result)+observe opts scenario = do+ ref <- newIORef []+ results <-+ launchTestTree opts (scenario $ \r -> modifyIORef ref (r :)) $+ \smap -> do+ done <- atomically $ traverse waitDone smap+ pure $ \_ -> pure $ toList done+ released <- reverse <$> readIORef ref+ case results of+ [result] -> pure (released, result)+ _ -> assertFailure $ "expected one test, got " ++ show (length results)+ where+ waitDone tv =+ readTVar tv >>= \case+ Done result -> pure result+ _ -> retry++failFastOff :: OptionSet+failFastOff = mempty++failFastOn :: OptionSet+failFastOn = setOption (FailFast True) mempty++assertPassed :: Result -> IO ()+assertPassed result = case resultOutcome result of+ Success -> pure ()+ Failure _ ->+ assertFailure $ "expected a pass, got: " ++ resultDescription result++-- | The test failed and its reported reason mentions the given text.+assertFailedWith :: String -> Result -> IO ()+assertFailedWith reason result = case resultOutcome result of+ Success -> assertFailure $ "expected a failure mentioning " ++ show reason+ Failure _ ->+ H.assertBool+ ( "reported reason "+ ++ show (resultDescription result)+ ++ " does not mention "+ ++ show reason+ )+ $ reason `isInfixOf` resultDescription result++-- | The reported reason does not mention the given text.+assertNotMentioning :: String -> Result -> IO ()+assertNotMentioning text result =+ H.assertBool+ ( "reported reason "+ ++ show (resultDescription result)+ ++ " mentions "+ ++ show text+ )+ $ not+ $ text `isInfixOf` resultDescription result++boom :: IO a+boom = throwIO $ userError "boom in step"++teardownSafetyTests :: TestTree+teardownSafetyTests =+ testGroup+ "teardown safety"+ [ testGroup "constructor runner" constructorTests+ , testGroup "free runner" freeTests+ ]++constructorTests :: [TestTree]+constructorTests =+ [ testCase+ "pass: every resource released in reverse order, reported passed"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "pass" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (pure (1 :: Int)) $+ Then (@?= 1) End+ released H.@?= ["r2", "r1"]+ assertPassed result+ , testCase+ "equality-failure: every resource released in reverse order, reported failed"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "equality-failure" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (pure (1 :: Int)) $+ Then (@?= 2) End+ released H.@?= ["r2", "r1"]+ assertFailedWith "Expected equality" result+ , testCase+ "when-throws: every resource released in reverse order, reported failed"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "when-throws" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (boom :: IO Int) $+ Then (@?= 1) End+ released H.@?= ["r2", "r1"]+ assertFailedWith "boom in step" result+ , testCase+ "then-throws: every resource released in reverse order, reported failed"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "then-throws" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (pure (1 :: Int)) $+ Then (\_ -> assertFailure "assertion in then") End+ released H.@?= ["r2", "r1"]+ assertFailedWith "assertion in then" result+ , testCase+ "acquisition-throws: resources acquired before it released in reverse order, reported failed"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "acquisition-throws"+ $ GivenAndAfter (pure "r1") release+ $ GivenAndAfter (pure "r2") release+ $ GivenAndAfter+ (throwIO (userError "acquisition of r3") :: IO String)+ release+ $ GivenAndAfter (pure "r4") release+ $ When (pure (1 :: Int))+ $ Then (@?= 1) End+ released H.@?= ["r2", "r1"]+ assertFailedWith "acquisition of r3" result+ , testCase "teardown-throws: the remaining teardowns still run" $ do+ (released, _) <- observe failFastOff $ \release ->+ testBehavior "teardown-throws" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") (throwingRelease release) $+ GivenAndAfter (pure "r3") release $+ When (pure (1 :: Int)) $+ Then (@?= 1) End+ released H.@?= ["r3", "r2", "r1"]+ , testCase+ "teardown-throws after passing steps: reported failed by the teardown"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "teardown-throws after passing steps" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") (throwingRelease release) $+ When (pure (1 :: Int)) $+ Then (@?= 1) End+ released H.@?= ["r2", "r1"]+ assertFailedWith "teardown r2" result+ , testCase+ "when-throws with a throwing teardown: the step's failure is reported"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "when-throws with a throwing teardown" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") (throwingRelease release) $+ When (boom :: IO Int) $+ Then (@?= 1) End+ assertFailedWith "boom in step" result+ assertNotMentioning "teardown r2" result+ released H.@?= ["r2", "r1"]+ , testCase+ "equality-failure with a throwing teardown: the step's failure is reported"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehavior "equality-failure with a throwing teardown" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") (throwingRelease release) $+ When (pure (1 :: Int)) $+ Then (@?= 2) End+ assertFailedWith "Expected equality" result+ assertNotMentioning "teardown r2" result+ released H.@?= ["r2", "r1"]+ , testCase+ "fail-fast on, equality-failure: teardown skipped, reported failed"+ $ do+ (released, result) <- observe failFastOn $ \release ->+ testBehavior "fail-fast equality-failure" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (pure (1 :: Int)) $+ Then (@?= 2) End+ released H.@?= []+ assertFailedWith "Expected equality" result+ , testCase+ "fail-fast on, when-throws: teardown skipped, reported failed"+ $ do+ (released, result) <- observe failFastOn $ \release ->+ testBehavior "fail-fast when-throws" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (boom :: IO Int) $+ Then (@?= 1) End+ released H.@?= []+ assertFailedWith "boom in step" result+ , testCase+ "fail-fast on, pass: every resource released in reverse order, reported passed"+ $ do+ (released, result) <- observe failFastOn $ \release ->+ testBehavior "fail-fast pass" $+ GivenAndAfter (pure "r1") release $+ GivenAndAfter (pure "r2") release $+ When (pure (1 :: Int)) $+ Then (@?= 1) End+ released H.@?= ["r2", "r1"]+ assertPassed result+ ]++freeTests :: [TestTree]+freeTests =+ [ testCase+ "free-when-throws: every resource released in reverse order, reported failed"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehaviorF id "free-when-throws" $ do+ givenAndAfter_ (pure "r1") release+ givenAndAfter_ (pure "r2") release+ when_ (boom :: IO Int) $ then_ (@?= 1)+ released H.@?= ["r2", "r1"]+ assertFailedWith "boom in step" result+ , testCase "free-teardown-throws: the remaining teardowns still run" $ do+ (released, _) <- observe failFastOff $ \release ->+ testBehaviorF id "free-teardown-throws" $ do+ givenAndAfter_ (pure "r1") release+ givenAndAfter_ (pure "r2") $ throwingRelease release+ givenAndAfter_ (pure "r3") release+ when_ (pure (1 :: Int)) $ then_ (@?= 1)+ released H.@?= ["r3", "r2", "r1"]+ , testCase+ "free-teardown-throws after passing steps: reported failed by the teardown"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehaviorF id "free-teardown-throws after passing steps" $ do+ givenAndAfter_ (pure "r1") release+ givenAndAfter_ (pure "r2") $ throwingRelease release+ when_ (pure (1 :: Int)) $ then_ (@?= 1)+ released H.@?= ["r2", "r1"]+ assertFailedWith "teardown r2" result+ , testCase+ "free-when-throws with a throwing teardown: the step's failure is reported"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehaviorF id "free-when-throws with a throwing teardown" $ do+ givenAndAfter_ (pure "r1") release+ givenAndAfter_ (pure "r2") $ throwingRelease release+ when_ (boom :: IO Int) $ then_ (@?= 1)+ assertFailedWith "boom in step" result+ assertNotMentioning "teardown r2" result+ released H.@?= ["r2", "r1"]+ , testCase+ "free equality-failure with a throwing teardown: the step's failure is reported"+ $ do+ (released, result) <- observe failFastOff $ \release ->+ testBehaviorF id "free equality-failure with a throwing teardown" $ do+ givenAndAfter_ (pure "r1") release+ givenAndAfter_ (pure "r2") $ throwingRelease release+ when_ (pure (1 :: Int)) $ then_ (@?= 2)+ assertFailedWith "Expected equality" result+ assertNotMentioning "teardown r2" result+ released H.@?= ["r2", "r1"]+ ]
tools/check-api.sh view
@@ -4,21 +4,28 @@ candidate=$2 scratch=$(mktemp -d) trap 'rm -rf "$scratch"' EXIT+modules=(+ Test.Tasty.Bdd+ Test.BDD.Language+ Test.BDD.LanguageFree+ System.CaptureStdout+) browse() { local source=$1 local output=$2- (- cd "$source"- ghci -ignore-dot-ghci -v0 -isrc \- src/Test/Tasty/Bdd.hs src/Test/BDD/Language.hs \- src/Test/BDD/LanguageFree.hs src/System/CaptureStdout.hs <<'GHC'-:browse Test.Tasty.Bdd-:browse Test.BDD.Language-:browse Test.BDD.LanguageFree-:browse System.CaptureStdout-:quit-GHC- ) > "$output" 2> "$output.errors"+ : > "$output"+ # One session per module, each headed by its name, so a difference is+ # attributed to the module that exports it.+ for module in "${modules[@]}"; do+ echo "-- :browse $module" >> "$output"+ (+ cd "$source"+ ghci -ignore-dot-ghci -v0 -isrc \+ src/Test/Tasty/Bdd.hs src/Test/BDD/Language.hs \+ src/Test/BDD/LanguageFree.hs src/System/CaptureStdout.hs \+ <<< ":browse $module"+ ) >> "$output" 2>> "$output.errors"+ done # GHCi can return success after a failed load: errors must also fail the gate. if grep -E 'error:|Failed,|Could not find module' "$output.errors"; then cat "$output.errors" >&2@@ -28,5 +35,27 @@ } browse "$baseline" "$scratch/published.api" browse "$candidate" "$scratch/candidate.api"+# The one accepted change since 0.1.0.1: the when lens of Test.BDD.Language+# is exported as whenAction with the same type. Apply exactly that rename to+# the baseline; any other difference still fails the comparison below.+python3 - "$scratch/published.api" <<'PY'+import pathlib, sys+path = pathlib.Path(sys.argv[1])+lines = path.read_text().split('\n')+lens = [+ 'when ::',+ ' Functor f => (m t -> f (m t)) -> BDDTest m t q -> f (BDDTest m t q)',+]+section = None+found = []+for index, line in enumerate(lines):+ if line.startswith('-- :browse '):+ section = line[len('-- :browse '):]+ elif section == 'Test.BDD.Language' and lines[index:index + 2] == lens:+ found.append(index)+assert len(found) == 1, f'expected one when lens in Test.BDD.Language, found {len(found)}'+lines[found[0]] = 'whenAction ::'+path.write_text('\n'.join(lines))+PY diff -u "$scratch/published.api" "$scratch/candidate.api"-echo 'Public API matches published tasty-bdd 0.1.0.1 on GHC 9.12.3.'+echo 'Public API matches published tasty-bdd 0.1.0.1 on GHC 9.12.3, except the when lens of Test.BDD.Language, renamed whenAction with the same type.'