From 700a82b1db250526b4e15ea6c029459216c8de85 Mon Sep 17 00:00:00 2001 From: Michael Walker Date: Tue, 30 Aug 2022 20:48:42 +0100 Subject: [PATCH] Make tasty-dejafu multi-predicate functions take the test group name These functions were added way back in the day to share work between a group of predicates. That functionality was dropped in 2017 when bound threads were implemented and running all tests began to require IO (#157) - confusingly, the comment about sharing work was kept for 5 more years (until #362). hunit-dejafu has very similar functions, and I wanted to make the APIs of both packages identical so far as possible. HUnit supports nameless test groups. Tasty does not. To keep the API the same as hunit-dejafu, I filled in a default group name: "Deja Fu Tests". But an unchangeable name isn't conducive to good testsuite output, and it's time to fix that mistake. I considered deprecating these functions instead, but they're not really causing any problems as such, so there's no harm in keeping them. Fixes #361 --- tasty-dejafu/CHANGELOG.rst | 17 ++++++++++ tasty-dejafu/Test/Tasty/DejaFu.hs | 52 ++++++++++++++++++------------- 2 files changed, 47 insertions(+), 22 deletions(-) diff --git a/tasty-dejafu/CHANGELOG.rst b/tasty-dejafu/CHANGELOG.rst index 64fc9a5..bd4bb5f 100644 --- a/tasty-dejafu/CHANGELOG.rst +++ b/tasty-dejafu/CHANGELOG.rst @@ -7,6 +7,23 @@ standard Haskell versioning scheme. .. _PVP: https://pvp.haskell.org/ +unreleased +---------- + +Changed +~~~~~~~ + +* (:issue:`361`) The following functions take a ``TestName`` parameter + to name the test group, rather than using "Deja Fu Tests": + + * ``Test.Tasty.DejaFu.testAuto`` + * ``Test.Tasty.DejaFu.testAutoWay`` + * ``Test.Tasty.DejaFu.testAutoWithSettings`` + * ``Test.Tasty.DejaFu.testDejafus`` + * ``Test.Tasty.DejaFu.testDejafusWay`` + * ``Test.Tasty.DejaFu.testDejafusWithSettings`` + + 2.0.0.9 (2022-08-30) -------------------- diff --git a/tasty-dejafu/Test/Tasty/DejaFu.hs b/tasty-dejafu/Test/Tasty/DejaFu.hs index f81df06..b69c293 100755 --- a/tasty-dejafu/Test/Tasty/DejaFu.hs +++ b/tasty-dejafu/Test/Tasty/DejaFu.hs @@ -5,7 +5,7 @@ -- | -- Module : Test.Tasty.DejaFu --- Copyright : (c) 2015--2019 Michael Walker +-- Copyright : (c) 2015--2022 Michael Walker -- License : MIT -- Maintainer : Michael Walker -- Stability : stable @@ -146,9 +146,11 @@ instance IsOption Way where -- | Automatically test a computation. In particular, look for -- deadlocks, uncaught exceptions, and multiple return values. -- --- @since 2.0.0.0 +-- @since unreleased testAuto :: (Eq a, Show a) - => Program pty IO a + => TestName + -- ^ The name of the test group. + -> Program pty IO a -- ^ The computation to test. -> TestTree testAuto = testAutoWithSettings defaultSettings @@ -156,12 +158,14 @@ testAuto = testAutoWithSettings defaultSettings -- | Variant of 'testAuto' which tests a computation under a given -- execution way and memory model. -- --- @since 2.0.0.0 +-- @since unreleased testAutoWay :: (Eq a, Show a) => Way -- ^ How to execute the concurrent program. -> MemType -- ^ The memory model to use for non-synchronised @IORef@ operations. + -> TestName + -- ^ The name of the test group. -> Program pty IO a -- ^ The computation to test. -> TestTree @@ -169,14 +173,16 @@ testAutoWay way = testAutoWithSettings . fromWayAndMemType way -- | Variant of 'testAuto' which takes a settings record. -- --- @since 2.0.0.0 +-- @since unreleased testAutoWithSettings :: (Eq a, Show a) => Settings IO a -- ^ The SCT settings. + -> TestName + -- ^ The name of the test group. -> Program pty IO a -- ^ The computation to test. -> TestTree -testAutoWithSettings settings = testDejafusWithSettings settings +testAutoWithSettings settings groupName = testDejafusWithSettings settings groupName [("Never Deadlocks", representative deadlocksNever) , ("No Exceptions", representative exceptionsNever) , ("Consistent Result", alwaysSame) @@ -226,14 +232,17 @@ testDejafuWithSettings :: Show b -> Program pty IO a -- ^ The computation to test. -> TestTree -testDejafuWithSettings settings name p = testDejafusWithSettings settings [(name, p)] +testDejafuWithSettings settings name p concio = + testconc settings concio (name, p) -- | Variant of 'testDejafu' which takes a collection of predicates to -- test. -- --- @since 2.0.0.0 +-- @since unreleased testDejafus :: Show b - => [(TestName, ProPredicate a b)] + => TestName + -- ^ The name of the test group. + -> [(TestName, ProPredicate a b)] -- ^ The list of predicates (with names) to check. -> Program pty IO a -- ^ The computation to test. @@ -243,12 +252,14 @@ testDejafus = testDejafusWithSettings defaultSettings -- | Variant of 'testDejafus' which takes a way to execute the program -- and a memory model. -- --- @since 2.0.0.0 +-- @since unreleased testDejafusWay :: Show b => Way -- ^ How to execute the concurrent program. -> MemType -- ^ The memory model to use for non-synchronised @IORef@ operations. + -> TestName + -- ^ The name of the test group. -> [(TestName, ProPredicate a b)] -- ^ The list of predicates (with names) to check. -> Program pty IO a @@ -258,16 +269,19 @@ testDejafusWay way = testDejafusWithSettings . fromWayAndMemType way -- | Variant of 'testDejafus' which takes a settings record. -- --- @since 2.0.0.0 +-- @since unreleased testDejafusWithSettings :: Show b => Settings IO a -- ^ The SCT settings. + -> TestName + -- ^ The name of the test group. -> [(TestName, ProPredicate a b)] -- ^ The list of predicates (with names) to check. -> Program pty IO a -- ^ The computation to test. -> TestTree -testDejafusWithSettings = testconc +testDejafusWithSettings settings groupName tests concio = + testGroup groupName $ map (testconc settings concio) tests ------------------------------------------------------------------------------- @@ -341,18 +355,12 @@ instance IsTest PropTest where -- | Produce a Tasty 'Test' from a Deja Fu unit test. testconc :: Show b => Settings IO a - -> [(TestName, ProPredicate a b)] -> Program pty IO a + -> (TestName, ProPredicate a b) -> TestTree -testconc settings tests concio = case map toTest tests of - [t] -> t - ts -> testGroup "Deja Fu Tests" ts - - where - toTest (name, p) = - let discarder = maybe id D.strengthenDiscard (get ldiscard settings) (pdiscard p) - traces = SCT.runSCTWithSettings (set ldiscard (Just discarder) settings) concio - in singleTest name $ ConcTest traces (peval p) +testconc settings concio (name, p) = singleTest name $ ConcTest traces (peval p) where + discarder = maybe id D.strengthenDiscard (get ldiscard settings) (pdiscard p) + traces = SCT.runSCTWithSettings (set ldiscard (Just discarder) settings) concio -- | Produce a Tasty 'TestTree' from a Deja Fu refinement property test. testprop :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p))