diff --git a/cabal.project b/cabal.project index 5b65ea64..9bac7797 100644 --- a/cabal.project +++ b/cabal.project @@ -14,3 +14,5 @@ if os(wasi) package splitmix tests: False benchmarks: False + constraints: + hashable -arch-native diff --git a/core-tests/core-tests.cabal b/core-tests/core-tests.cabal index 3a1adff0..2e63e208 100644 --- a/core-tests/core-tests.cabal +++ b/core-tests/core-tests.cabal @@ -56,3 +56,9 @@ executable multiple-pattern-test main-is: multiple-pattern-test.hs build-depends: base < 5, tasty, tasty-hunit ghc-options: -Wall -fno-warn-type-defaults + +executable top-level-options + import: commons + main-is: top-level-options.hs + build-depends: base < 5, tasty, tasty-hunit + ghc-options: -Wall -fno-warn-type-defaults diff --git a/core-tests/top-level-options.hs b/core-tests/top-level-options.hs new file mode 100644 index 00000000..5fee8a79 --- /dev/null +++ b/core-tests/top-level-options.hs @@ -0,0 +1,11 @@ +module Main where + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Runners + +main :: IO () +main = defaultMain $ + localOption (ListTests True) $ + testCase "list me" $ + assertFailure "should not be executed" diff --git a/core/CHANGELOG.md b/core/CHANGELOG.md index c9a89e47..5762addd 100644 --- a/core/CHANGELOG.md +++ b/core/CHANGELOG.md @@ -17,6 +17,8 @@ _YYYY-MM-DD_ ([#403](https://github.com/UnkindPartition/tasty/pull/403)). * Add `instance Eq Timeout` and `instance Ord Timeout` ([#415](https://github.com/UnkindPartition/tasty/pull/415)). +* Add ability to supply options for launchers and reporters at the top-level of test tree + ([#417](https://github.com/UnkindPartition/tasty/pull/417)). Version 1.5 --------------- diff --git a/core/Test/Tasty/Ingredients.hs b/core/Test/Tasty/Ingredients.hs index 7727f4f7..5ea84beb 100644 --- a/core/Test/Tasty/Ingredients.hs +++ b/core/Test/Tasty/Ingredients.hs @@ -92,6 +92,8 @@ data Ingredient -- -- For a 'TestReporter', this function automatically starts running the -- tests in the background. +-- +-- This function is not publicly exposed. tryIngredient :: Ingredient -> OptionSet -> TestTree -> Maybe (IO Bool) tryIngredient (TestReporter _ report) opts testTree = do -- Maybe monad reportFn <- report opts testTree @@ -106,8 +108,10 @@ tryIngredient (TestManager _ manage) opts testTree = -- -- @since 0.4 tryIngredients :: [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool) -tryIngredients ins opts tree = +tryIngredients ins opts' tree' = msum $ map (\i -> tryIngredient i opts tree) ins + where + (opts, tree) = applyTopLevelPlusTestOptions opts' tree' -- | Return the options which are relevant for the given ingredient. -- diff --git a/core/Test/Tasty/Run.hs b/core/Test/Tasty/Run.hs index 3f00666d..f377037d 100644 --- a/core/Test/Tasty/Run.hs +++ b/core/Test/Tasty/Run.hs @@ -6,6 +6,7 @@ module Test.Tasty.Run ( Status(..) , StatusMap , launchTestTree + , applyTopLevelPlusTestOptions , DependencyException(..) ) where @@ -576,6 +577,31 @@ destroyResource restore (Finalizer doRelease stateVar _) = join . atomically $ d FailedToCreate {} -> return $ return Nothing Destroyed -> return $ return Nothing +-- While tasty allows to configure 'OptionSet' at any level of test tree, +-- it often has any effect only on options of test providers (class IsTest). +-- But test runners and reporters typically only look into the OptionSet +-- they were given as an argument. This is not unreasonable: e. g., if an option +-- is a log filename you cannot expect to change it in the middle of the run. +-- It is however too restrictive: there is no way to use 'defaultMain' but hardcode +-- a global option, without passing it via command line. +-- +-- 'applyTopLevelPlusTestOptions' allows for a compromise: unwrap top-level +-- 'PlusTestOptions' from the 'TestTree' and apply them to the 'OptionSet' +-- from command line. This way a user can wrap their tests in +-- 'adjustOption' / 'localOption' forcing, for instance, 'NumThreads' to 1. +-- +-- This function is not publicly exposed. +applyTopLevelPlusTestOptions + :: OptionSet + -- ^ Raw options, typically from the command-line arguments. + -> TestTree + -- ^ Raw test tree. + -> (OptionSet, TestTree) + -- ^ Extended options and test tree stripped of outer layers of 'PlusTestOptions'. +applyTopLevelPlusTestOptions opts (PlusTestOptions f tree) = + applyTopLevelPlusTestOptions (f opts) tree +applyTopLevelPlusTestOptions opts tree = (opts, tree) + -- | Start running the tests (in background, in parallel) and pass control -- to the callback. -- @@ -602,11 +628,16 @@ launchTestTree -- all resource initializers and finalizers, which is why it is more -- accurate than what could be measured from inside the first callback. -> IO a -launchTestTree opts tree k0 = do +launchTestTree opts' tree' k0 = do + -- Normally 'applyTopLevelPlusTestOptions' has been already applied by + -- 'Test.Tasty.Ingredients.tryIngredients', but 'launchTestTree' is exposed + -- publicly, so in principle clients could use it outside of 'tryIngredients'. + -- Thus running 'applyTopLevelPlusTestOptions' again, just to be sure. + let (opts, tree) = applyTopLevelPlusTestOptions opts' tree' (testActions, fins) <- createTestActions opts tree - let NumThreads numTheads = lookupOption opts + let NumThreads numThreads = lookupOption opts (t,k1) <- timed $ do - abortTests <- runInParallel numTheads (testAction <$> testActions) + abortTests <- runInParallel numThreads (testAction <$> testActions) (do let smap = IntMap.fromDistinctAscList $ zip [0..] (testStatus <$> testActions) k0 smap) `finallyRestore` \restore -> do