diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,21 @@ Changes ======= +Version 3.3.2 (18 Jul 2024) +------------- + +* Make `--accept` work (closes [#24](https://github.com/phile314/tasty-silver/issues/24)). + With this flag the golden value will automatically get updated. + + It is possible to run `--accept` together with `--interactive` + although this combination does not make much sense. + (This will show the diff interactively but then just update the golden value.) + + The fix of `--accept` unifies the code for interactive and non-interactive test runs + and might have introduced changes in the test output formatting. + +* Tested with GHC 8.0 - 9.10.1. + Version 3.3.1.3 (20 Oct 2023) --------------- diff --git a/Test/Tasty/Silver/Interactive.hs b/Test/Tasty/Silver/Interactive.hs --- a/Test/Tasty/Silver/Interactive.hs +++ b/Test/Tasty/Silver/Interactive.hs @@ -182,8 +182,7 @@ let ?colors = useColor whenColor isTerm - let - outp = produceOutput opts tests + outp <- produceOutput opts tests stats <- case () of { _ | hideSuccesses && isTerm && ansiTricks -> @@ -205,11 +204,6 @@ -- | Like 'printDiff', but uses @less@ if available. -showDiff :: TestName -> GDiff -> IO () -showDiff n d = do - useLess <- useLess - showDiff_ useLess n d - showDiff_ :: Bool -> TestName -> GDiff -> IO () showDiff_ _ _ Equal = error "Can't show diff for equal values." showDiff_ True n (ShowDiffed _ t) = showInLess n t @@ -447,13 +441,19 @@ type Level = Int -produceOutput :: (?colors :: Bool) => OptionSet -> TestTree -> TestOutput -produceOutput opts tree = +produceOutput :: (?colors :: Bool) => OptionSet -> TestTree -> IO TestOutput +produceOutput opts tree = do let -- Do not retain the reference to the tree more than necessary !alignment = computeAlignment opts tree Interactive isInteractive = lookupOption opts + AcceptTests accept = lookupOption opts + -- We always print timing in non-interactive mode + forceTime = not isInteractive + -- In batch mode, we never use 'less' to show result. + useLess <- if isInteractive then useLess else pure False + let handleSingleTest :: (IsTest t, ?colors :: Bool) => OptionSet -> TestName -> t -> Ap (Reader Level) TestOutput @@ -465,7 +465,8 @@ pref = indent level ++ replicate (length name) ' ' ++ " " ++ align printTestName = printf "%s%s: %s" (indent level) name align - printResultLine result forceTime = do + + printResultLine result = do -- use an appropriate printing function let resTy = getResultType result @@ -482,73 +483,67 @@ printFn (printf " (%.2fs)" $ resultTime result) printFn "\n" + possiblyAccept msgPass msgFail update = do + isUpd <- if isInteractive then tryAccept pref update else do + putStr pref + when accept update + pure accept + let r = + if isUpd + then ( testPassed msgPass + , mempty { statCreatedGolden = 1 } ) + else ( testFailed msgFail + , mempty { statFailures = 1 } ) + printResultLine (fst r) + return r handleTestResult result = do - -- non-interactive mode. Uses different order of printing, - -- as using the interactive layout doesn't go that well - -- with printing the diffs to stdout. - -- - printResultLine result True - - rDesc <- formatMessage $ resultDescription result - when (not $ null rDesc) $ (case getResultType result of - RTSuccess -> infoOk - RTIgnore -> infoWarn - RTFail -> infoFail) $ - printf "%s%s\n" pref (formatDesc (level+1) rDesc) - - stat' <- printTestOutput pref name result - - return stat' - - handleTestResultInteractive result = do - (result', stat') <- case (resultOutcome result) of + (result', stat') <- case resultOutcome result of Failure (TestThrewException e) -> case fromException e of - Just (Mismatch (GRDifferent _ _ _ Nothing)) -> do - printResultLine result False - s <- printTestOutput pref name result - return (testFailed "", s) - Just (Mismatch (GRNoGolden a shw (Just upd))) -> do - printf "Golden value missing. Press to show actual value.\n" - _ <- getLine - let a' = runIdentity a - shw' <- shw a' - showValue name shw' - isUpd <- tryAccept pref $ upd a' - let r = - if isUpd - then ( testPassed "Created golden value." - , mempty { statCreatedGolden = 1 } ) - else ( testFailed "Golden value missing." - , mempty { statFailures = 1 } ) - printResultLine (fst r) False - return r + + Just (Mismatch (GRNoGolden (Identity a) shw (Just upd))) -> do + if isInteractive then do + printf "Golden value missing. Press to show actual value.\n" + _ <- getLine + showValue name =<< shw a + else do + infoFail $ printf "%sActual value is:\n" pref + hsep + printValue name =<< shw a + hsep + possiblyAccept "Created golden value." "Golden value missing." $ + upd a + Just (Mismatch (GRDifferent _ a diff (Just upd))) -> do printf "Golden value differs from actual value.\n" - showDiff name diff - isUpd <- tryAccept pref $ upd a - let r = - if isUpd - then ( testPassed "Updated golden value." - , mempty { statUpdatedGolden = 1 } ) - else ( testFailed "Golden value does not match actual output." - , mempty { statFailures = 1 } ) - printResultLine (fst r) False - return r + unless useLess hsep + showDiff_ useLess name diff + unless useLess hsep + possiblyAccept "Updated golden value." "Golden value does not match actual output." $ + upd a + + Just (Mismatch (GRDifferent _ _ diff Nothing)) -> do + printResultLine result + infoFail $ printf "%sDiff between actual and golden value:\n" pref + hsep + printDiff name diff + hsep + return (testFailed "", mempty { statFailures = 1 }) + Just (Mismatch _) -> error "Impossible case!" Just Disabled -> do - printResultLine result False + printResultLine result return ( result , mempty { statDisabled = 1 } ) Nothing -> do - printResultLine result False + printResultLine result return (result, mempty {statFailures = 1}) Success -> do - printResultLine result False + printResultLine result return (result, mempty { statSuccesses = 1 }) Failure _ -> do - printResultLine result False + printResultLine result return (result, mempty { statFailures = 1 }) let result'' = result' { resultTime = resultTime result } @@ -562,8 +557,7 @@ return stat' - let handleTestResult' = (if isInteractive then handleTestResultInteractive else handleTestResult) - return $ HandleTest name printTestName handleTestResult' + return $ HandleTest name printTestName handleTestResult handleGroup :: OptionSet -> TestName -> [Ap (Reader Level) TestOutput] -> Ap (Reader Level) TestOutput handleGroup _ name grp = Ap $ do @@ -573,8 +567,8 @@ printBody = runReader (getApp $ mconcat grp) (level + 1) return $ PrintHeading printHeading printBody - in - flip runReader 0 $ getApp $ + + return $ flip runReader 0 $ getApp $ foldTestTree trivialFold { foldSingle = handleSingleTest @@ -585,30 +579,6 @@ #endif } opts tree - -printTestOutput :: (?colors :: Bool) => String -> TestName -> Result -> IO Statistics -printTestOutput prefix name result = case resultOutcome result of - Failure (TestThrewException e) -> - case fromException e of - Just (Mismatch (GRNoGolden a shw _)) -> do - infoFail $ printf "%sActual value is:\n" prefix - let a' = runIdentity a - shw' <- shw a' - hsep - printValue name shw' - hsep - return ( mempty { statFailures = 1 } ) - Just (Mismatch (GRDifferent _ _ diff _)) -> do - infoFail $ printf "%sDiff between actual and golden value:\n" prefix - hsep - printDiff name diff - hsep - return ( mempty { statFailures = 1 } ) - Just (Mismatch _) -> error "Impossible case!" - Just Disabled -> return ( mempty { statDisabled = 1 } ) - Nothing -> return ( mempty { statFailures = 1 } ) - Failure _ -> return ( mempty { statFailures = 1 } ) - Success -> return ( mempty { statSuccesses = 1 } ) hsep :: IO () hsep = putStrLn (replicate 40 '=') diff --git a/tasty-silver.cabal b/tasty-silver.cabal --- a/tasty-silver.cabal +++ b/tasty-silver.cabal @@ -1,6 +1,6 @@ cabal-version: 1.14 name: tasty-silver -version: 3.3.1.3 +version: 3.3.2 synopsis: A fancy test runner, including support for golden tests. description: This package provides a fancy test runner and support for «golden testing». @@ -18,8 +18,8 @@ license-file: LICENSE Homepage: https://github.com/phile314/tasty-silver Bug-reports: https://github.com/phile314/tasty-silver/issues -author: Philipp Hausmann, Roman Cheplyaka and others -maintainer: Philipp Hausmann, Andreas Abel +author: Philipp Hausmann, Andreas Abel, Roman Cheplyaka, and others +maintainer: Andreas Abel, Philipp Hausmann -- copyright: category: Testing build-type: Simple @@ -29,9 +29,10 @@ README.md tested-with: - GHC == 9.8.1 - GHC == 9.6.3 - GHC == 9.4.7 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 @@ -73,7 +74,8 @@ -- LambdaCase supported since GHC 7.6 (base-4.6) , ansi-terminal >= 0.6.2.1 , async - , bytestring >= 0.9.2.1 + , bytestring >= 0.10.0.0 + -- bytestring-0.10 needed by process-extras-0.3 , containers , directory >= 1.2.3.0 -- withCurrentDirectory needs at least 1.2.3.0