tasty 1.5 → 1.5.1
raw patch · 10 files changed
+131/−63 lines, 10 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +19/−0
- Control/Concurrent/Async.hs +1/−1
- README.md +6/−3
- Test/Tasty/Core.hs +15/−7
- Test/Tasty/Ingredients.hs +5/−1
- Test/Tasty/Ingredients/ConsoleReporter.hs +25/−41
- Test/Tasty/Options/Core.hs +12/−1
- Test/Tasty/Patterns.hs +9/−1
- Test/Tasty/Run.hs +36/−5
- tasty.cabal +3/−3
CHANGELOG.md view
@@ -1,6 +1,25 @@ Changes ======= +Version 1.5.1+--------------++_2024-06-22_++* Performance improvements+ ([#389](https://github.com/UnkindPartition/tasty/pull/389),+ [#390](https://github.com/UnkindPartition/tasty/pull/390)).+* Progress reporting in Emacs: use `\r` instead of ANSI escape sequences+ ([#393](https://github.com/UnkindPartition/tasty/pull/393)).+* Console reporter: fix unintended change to `foldHeading`+ ([#396](https://github.com/UnkindPartition/tasty/pull/396)).+* Prune empty test subtrees from `TestTree`+ ([#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 ---------------
Control/Concurrent/Async.hs view
@@ -48,7 +48,7 @@ import Control.Monad import Data.IORef import Data.Typeable-import GHC.Conc+import GHC.Conc (ThreadId(..)) import GHC.Exts import GHC.IO hiding (onException)
README.md view
@@ -820,9 +820,12 @@ 3. **Q**: Patterns with slashes do not work on Windows. How can I fix it? - **A**: If you are running Git for Windows terminal, it has a habit of converting slashes- to backslashes. Set `MSYS_NO_PATHCONV=1` to prevent this behaviour, or follow other- suggestions from [Known Issues](https://github.com/git-for-windows/build-extra/blob/main/ReleaseNotes.md#known-issues).+ **A**: If you are running Git for Windows terminal, it has a habit of+ converting slashes to backslashes. Set `MSYS_NO_PATHCONV=1` when running the+ Git for Windows terminal and `MSYS2_ARG_CONV_EXCL=*` when running a MinGW+ bash directly to prevent this behaviour, or follow other suggestions from+ [Known+ Issues](https://github.com/git-for-windows/build-extra/blob/main/ReleaseNotes.md#known-issues). ## Press
Test/Tasty/Core.hs view
@@ -540,7 +540,7 @@ go :: Seq.Seq TestName -> AnnTestTree OptionSet -> AnnTestTree (OptionSet, Path) go path = \case AnnEmptyTestTree -> AnnEmptyTestTree- AnnSingleTest opts name tree -> + AnnSingleTest opts name tree -> AnnSingleTest (opts, path |> name) name tree AnnTestGroup opts name trees -> let newPath = path |> name in@@ -554,7 +554,15 @@ filterByPattern :: AnnTestTree (OptionSet, Path) -> AnnTestTree OptionSet filterByPattern = snd . go (Any False) where- go + mkGroup opts name xs = case filter isNonEmpty xs of+ [] -> AnnEmptyTestTree+ ys -> AnnTestGroup opts name ys++ isNonEmpty = \case+ AnnEmptyTestTree -> False+ _ -> True++ go :: ForceTestMatch -> AnnTestTree (OptionSet, Path) -> (TestMatched, AnnTestTree OptionSet)@@ -565,22 +573,22 @@ AnnSingleTest (opts, path) name tree | getAny forceMatch || testPatternMatches (lookupOption opts) path -> (Any True, AnnSingleTest opts name tree)- | otherwise + | otherwise -> (Any False, AnnEmptyTestTree) - AnnTestGroup (opts, _) name [] ->- (forceMatch, AnnTestGroup opts name [])+ AnnTestGroup _ _ [] ->+ (forceMatch, AnnEmptyTestTree) AnnTestGroup (opts, _) name trees -> case lookupOption opts of Parallel -> bimap mconcat- (AnnTestGroup opts name)+ (mkGroup opts name) (unzip (map (go forceMatch) trees)) Sequential _ -> second- (AnnTestGroup opts name)+ (mkGroup opts name) (mapAccumR go forceMatch trees) AnnWithResource (opts, _) res0 tree ->
Test/Tasty/Ingredients.hs view
@@ -92,6 +92,8 @@ -- -- 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 @@ -- -- @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. --
Test/Tasty/Ingredients/ConsoleReporter.hs view
@@ -50,6 +50,7 @@ import Test.Tasty.Runners.Utils import Text.Printf import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet import Data.Char #ifdef USE_WCWIDTH import Foreign.C.Types (CInt(..), CWchar(..))@@ -151,8 +152,6 @@ name (replicate postNamePadding ' ') - resultPosition = length testNamePadded- printTestName = do putStr testNamePadded hFlush stdout@@ -170,11 +169,11 @@ ("", pct) -> printf "%.0f%% " pct (txt, 0.0) -> printf "%s" txt (txt, pct) -> printf "%s: %.0f%% " txt pct- setCursorColumn resultPosition- infoOk msg -- A new progress message may be shorter than the previous one- -- so we must clean until the end of the line- clearFromCursorToLineEnd+ -- so we must clean whole line and print anew.+ putChar '\r'+ putStr testNamePadded+ infoOk msg hFlush stdout printTestResult result = do@@ -190,8 +189,8 @@ time = resultTime result when getAnsiTricks $ do- setCursorColumn resultPosition- clearFromCursorToLineEnd+ putChar '\r'+ putStr testNamePadded printFn (resultShortDescription result) when (floor (time * 1e6) >= minDurationMicros) $@@ -294,8 +293,9 @@ , Any True) foldHeading _name printHeading (printBody, Any nonempty) = ( Traversal $ do- when nonempty $ printHeading- getTraversal printBody+ when nonempty $ do+ printHeading :: IO ()+ getTraversal printBody , Any nonempty ) @@ -433,8 +433,8 @@ where f :: Int -> TVar Status- -> (IntMap.IntMap () -> Int -> STM (IO Bool))- -> (IntMap.IntMap () -> Int -> STM (IO Bool))+ -> (IntSet.IntSet -> Int -> STM (IO Bool))+ -> (IntSet.IntSet -> Int -> STM (IO Bool)) -- ok_tests is a set of tests that completed successfully -- lookahead is the number of unfinished tests that we are allowed to -- look at@@ -447,23 +447,23 @@ case this_status of Done r -> if resultSuccessful r- then k (IntMap.insert key () ok_tests) lookahead+ then k (IntSet.insert key ok_tests) lookahead else return $ return False _ -> k ok_tests (lookahead-1) -- next_iter is called when we end the current iteration, -- either because we reached the end of the test tree -- or because we exhausted the lookahead- next_iter :: IntMap.IntMap () -> STM (IO Bool)+ next_iter :: IntSet.IntSet -> STM (IO Bool) next_iter ok_tests = -- If we made no progress at all, wait until at least some tests -- complete. -- Otherwise, reduce the set of tests we are looking at.- if IntMap.null ok_tests+ if IntSet.null ok_tests then retry- else return $ statusMapResult lookahead0 (IntMap.difference smap ok_tests)+ else return $ statusMapResult lookahead0 (IntMap.withoutKeys smap ok_tests) - finish :: IntMap.IntMap () -> Int -> STM (IO Bool)+ finish :: IntSet.IntSet -> Int -> STM (IO Bool) finish ok_tests _ = next_iter ok_tests -- }}}@@ -749,35 +749,19 @@ then paddedDesc else chomped -data Maximum a- = Maximum a- | MinusInfinity--instance Ord a => Sem.Semigroup (Maximum a) where- Maximum a <> Maximum b = Maximum (a `max` b)- MinusInfinity <> a = a- a <> MinusInfinity = a-instance Ord a => Monoid (Maximum a) where- mempty = MinusInfinity-#if !MIN_VERSION_base(4,11,0)- mappend = (Sem.<>)-#endif- -- | Compute the amount of space needed to align \"OK\"s and \"FAIL\"s computeAlignment :: OptionSet -> TestTree -> Int computeAlignment opts =- fromMonoid .- foldTestTree- trivialFold- { foldSingle = \_ name _ level -> Maximum (stringWidth name + level)- , foldGroup = \_opts _ m -> mconcat m . (+ indentSize)+ max 0 .+ foldTestTree0+ minBound+ TreeFold+ { foldSingle = \_ name _ -> stringWidth name+ , foldGroup = \_ _ m -> if null m then minBound else maximum m + indentSize+ , foldResource = \_ _ f -> f $ throwIO NotRunningTests+ , foldAfter = \_ _ _ b -> b } opts- where- fromMonoid m =- case m 0 of- MinusInfinity -> 0- Maximum x -> x -- | Compute the length/width of the string as it would appear in a monospace -- terminal. This takes into account that even in a “mono”space font, not
Test/Tasty/Options/Core.hs view
@@ -58,7 +58,18 @@ -- @\"0.5m\"@), so that we can print it back. 'Integer' is the number of -- microseconds. | NoTimeout- deriving (Show, Typeable)+ deriving+ ( Eq+ -- ^ Auto-derived instance, just to allow storing in a 'Map' and such.+ --+ -- @since 1.5.1+ , Ord+ -- ^ Auto-derived instance, just to allow storing in a 'Map' and such.+ --+ -- @since 1.5.1+ , Show+ , Typeable+ ) instance IsOption Timeout where defaultValue = NoTimeout
Test/Tasty/Patterns.hs view
@@ -48,7 +48,15 @@ defaultValue = noPattern parseValue = parseTestPattern optionName = return "pattern"- optionHelp = return "Select only tests which satisfy a pattern or awk expression"+#if !defined(mingw32_HOST_OS)+ optionHelp = return "Select only tests which satisfy a pattern or awk expression."+#else+ optionHelp = return+ $ unwords [ "Select only tests which satisfy a pattern or awk expression."+ , "Consider using `MSYS_NO_PATHCONV=1` or `MSYS2_ARG_CONV_EXCL=*`"+ , "to prevent pattern mangling."+ ]+#endif optionCLParser = fmap (TestPattern . fmap (foldr1 And) . nonEmpty . catMaybes . coerce @[TestPattern]) . some $ mkOptionCLParser (short 'p' <> metavar "PATTERN")
Test/Tasty/Run.hs view
@@ -6,10 +6,11 @@ ( Status(..) , StatusMap , launchTestTree+ , applyTopLevelPlusTestOptions , DependencyException(..) ) where -import qualified Data.IntMap as IntMap+import qualified Data.IntMap.Strict as IntMap import qualified Data.Sequence as Seq import qualified Data.Foldable as F import Data.Int (Int64)@@ -576,6 +577,31 @@ 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,12 +628,17 @@ -- 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)- (do let smap = IntMap.fromList $ zip [0..] (testStatus <$> testActions)+ abortTests <- runInParallel numThreads (testAction <$> testActions)+ (do let smap = IntMap.fromDistinctAscList $ zip [0..] (testStatus <$> testActions) k0 smap) `finallyRestore` \restore -> do -- Tell all running tests to wrap up.
tasty.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: tasty-version: 1.5+version: 1.5.1 synopsis: Modern and extensible testing framework description: Tasty is a modern testing framework for Haskell. It lets you combine your unit tests, golden@@ -61,11 +61,11 @@ build-depends: base >= 4.9 && < 5, stm >= 2.3 && < 2.6,- containers < 0.7,+ containers >= 0.5.8 && < 0.8, transformers >= 0.5 && < 0.7, tagged >= 0.5 && < 0.9, optparse-applicative >= 0.14 && < 0.19,- ansi-terminal >= 0.9 && < 1.1+ ansi-terminal >= 0.9 && < 1.2 -- No reason to depend on unbounded-delays on 64-bit architecture if(!arch(x86_64) && !arch(aarch64))