tasty-silver 3.1.1 → 3.1.2
raw patch · 4 files changed
+101/−53 lines, 4 files
Files
- CHANGELOG.md +6/−0
- Test/Tasty/Silver/Interactive.hs +93/−51
- Test/Tasty/Silver/Internal.hs +1/−1
- tasty-silver.cabal +1/−1
CHANGELOG.md view
@@ -1,6 +1,12 @@ Changes ======= +Version 3.1.2+-------------++* Add non-interactive mode to test runner, printing diffs/actual values directly to stdout.+ Useful for (travis) CI.+ Version 3.1.1 -------------
Test/Tasty/Silver/Interactive.hs view
@@ -30,6 +30,7 @@ import Data.Tagged import Data.Maybe import Data.Monoid+import qualified Data.Text.IO as TIO #if __GLASGOW_HASKELL__ < 708 import Data.Foldable (foldMap) #endif@@ -57,11 +58,12 @@ import Test.Tasty.Providers import qualified Data.Map as M import System.Console.ANSI+import qualified System.Process.Text as PTL -- | Like @defaultMain@ from the main tasty package, but also includes the -- golden test management capabilities. defaultMain :: TestTree -> IO ()-defaultMain = defaultMainWithIngredients [interactiveTests, listingTests, consoleTestReporter]+defaultMain = defaultMainWithIngredients [listingTests, interactiveTests] newtype Interactive = Interactive Bool deriving (Eq, Ord, Typeable)@@ -73,19 +75,16 @@ optionCLParser = flagCLParser (Just 'i') (Interactive True) -data ResultStatus = RPass | RFail | RInteract GoldenResultI+data ResultStatus = RPass | RFail | RMismatch GoldenResultI type GoldenStatus = GoldenResultI type GoldenStatusMap = TVar (M.Map TestName GoldenStatus) interactiveTests :: Ingredient-interactiveTests = TestManager [Option (Proxy :: Proxy Interactive)] $+interactiveTests = TestManager [ Option (Proxy :: Proxy Interactive) ] $ \opts tree ->- case lookupOption opts of- Interactive False -> Nothing- Interactive True -> Just $- runTestsInteractive opts tree+ Just $ runTestsInteractive opts tree runSingleTest :: IsTest t => GoldenStatusMap -> TestName -> OptionSet -> t -> (Progress -> IO ()) -> IO Result@@ -139,7 +138,6 @@ } return $ \time -> do--- stats <- computeStatistics smap printStatistics stats time return $ statFailures stats == 0 @@ -148,9 +146,28 @@ return r +printDiff :: TestName -> GDiff -> IO ()+printDiff n (DiffText _ tGold tAct) = withDiffEnv+ (\fGold fAct -> do+ (_, stdOut, _) <- PTL.readProcessWithExitCode "sh" ["-c", "git diff --no-index --text " ++ fGold ++ " " ++ fAct] T.empty+ TIO.putStrLn stdOut + )+ n tGold tAct+printDiff _ (ShowDiffed _ t) = TIO.putStrLn t+printDiff _ Equal = error "Can't print diff for equal values."+ showDiff :: TestName -> GDiff -> IO ()-showDiff n (DiffText _ tGold tAct) = do+showDiff n (DiffText _ tGold tAct) = withDiffEnv+ (\fGold fAct -> callProcess "sh"+ ["-c", "git diff --color=always --no-index --text " ++ fGold ++ " " ++ fAct ++ " | less -r > /dev/tty"])+ n tGold tAct+showDiff n (ShowDiffed _ t) = showInLess n t+showDiff _ Equal = error "Can't show diff for equal values."++-- Stores the golden/actual text in two files, so we can use it for git diff.+withDiffEnv :: (FilePath -> FilePath -> IO ()) -> TestName -> T.Text -> T.Text -> IO ()+withDiffEnv cont n tGold tAct = do withSystemTempFile (n <.> "golden") (\fGold hGold -> do withSystemTempFile (n <.> "actual") (\fAct hAct -> do hSetBinaryMode hGold True@@ -159,14 +176,14 @@ BS.hPut hAct (encodeUtf8 tAct) hClose hGold hClose hAct- callProcess "sh"- ["-c", "git diff --color=always --no-index --text " ++ fGold ++ " " ++ fAct ++ " | less -r > /dev/tty"]+ cont fGold fAct ) ) -showDiff n (ShowDiffed _ t) = showInLess n t-showDiff _ Equal = error "Can't show diff for equal values..." +printValue :: TestName -> GShow -> IO ()+printValue _ (ShowText t) = TIO.putStrLn t+ showValue :: TestName -> GShow -> IO () showValue n (ShowText t) = showInLess n t @@ -186,8 +203,8 @@ case ans of "y" -> do upd new- printf "%s" pref when isTerm hideCursor+ printf "%s" pref return True "n" -> do printf "%s" pref@@ -227,6 +244,7 @@ let -- Do not retain the reference to the tree more than necessary !alignment = computeAlignment opts tree+ Interactive isInteractive = lookupOption opts handleSingleTest :: (IsTest t, ?colors :: Bool)@@ -239,16 +257,66 @@ pref = indent level ++ replicate (length name) ' ' ++ " " ++ align printTestName = printf "%s%s: %s" (indent level) name align+ hsep = putStrLn (replicate 40 '=')+ printResultLine success time forceTime = do+ -- use an appropriate printing function+ let+ printFn =+ if success+ then ok+ else fail+ if success+ then printFn "OK"+ else printFn "FAIL"+ -- print time only if it's significant+ when (time >= 0.01 || forceTime) $+ printFn (printf " (%.2fs)" time)+ printFn "\n" - printTestResult (result, resultStatus) = do++ handleTestResult (result, resultStatus) = 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 (resultSuccessful result) (resultTime result) True++ rDesc <- formatMessage $ resultDescription result+ when (not $ null rDesc) $+ (if resultSuccessful result then infoOk else infoFail) $+ printf "%s%s\n" pref (formatDesc (level+1) rDesc)++ stat' <- case resultStatus of+ RMismatch (GRNoGolden a shw _) -> do+ infoFail $ printf "%sActual value is:\n" pref+ let a' = runIdentity a+ shw' <- shw a'+ hsep+ printValue name shw'+ hsep+ return ( mempty { statFailures = 1 } )+ RMismatch (GRDifferent _ _ diff _) -> do+ infoFail $ printf "%sDiff between actual and golden value:\n" pref+ hsep+ printDiff name diff+ hsep+ return ( mempty { statFailures = 1 } )+ RMismatch _ -> error "Impossible case!"+ RPass -> return ( mempty { statSuccesses = 1 } )+ RFail -> return ( mempty { statFailures = 1 } )++ return stat'++ handleTestResultInteractive (result, resultStatus) = do (result', stat') <- case resultStatus of- RInteract (GRNoGolden a shw upd) -> do+ RMismatch (GRNoGolden a shw upd) -> do printf "Golden value missing. Press <enter> to show actual value.\n" _ <- getLine let a' = runIdentity a shw' <- shw a' showValue name shw' isUpd <- tryAccept pref name upd a'+ return ( if isUpd then ( testPassed "Created golden value."@@ -256,7 +324,7 @@ else ( testFailed "Golden value missing." , mempty { statFailures = 1 } ) )- RInteract (GRDifferent _ a diff upd) -> do+ RMismatch (GRDifferent _ a diff upd) -> do printf "Golden value differs from actual value.\n" showDiff name diff isUpd <- tryAccept pref name upd a@@ -267,32 +335,21 @@ else ( testFailed "Golden value does not match actual output." , mempty { statFailures = 1 } ) )- RInteract _ -> error "Impossible case!"+ RMismatch _ -> error "Impossible case!" RPass -> return (result, mempty { statSuccesses = 1 }) RFail -> return (result, mempty { statFailures = 1 }) rDesc <- formatMessage $ resultDescription result' - -- use an appropriate printing function- let- printFn =- if resultSuccessful result'- then ok- else fail- time = resultTime result- if resultSuccessful result'- then printFn "OK"- else printFn "FAIL"- -- print time only if it's significant- when (time >= 0.01) $- printFn (printf " (%.2fs)" time)- printFn "\n"+ printResultLine (resultSuccessful result') (resultTime result) False when (not $ null rDesc) $ (if resultSuccessful result' then infoOk else infoFail) $- printf "%s%s\n" (indent $ level + 1) (formatDesc (level+1) rDesc)+ printf "%s%s\n" pref (formatDesc (level+1) rDesc)+ return stat' - return $ HandleTest name printTestName printTestResult+ let handleTestResult' = (if isInteractive then handleTestResultInteractive else handleTestResult)+ return $ HandleTest name printTestName handleTestResult' handleGroup :: TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput handleGroup name grp = Ap $ do@@ -346,17 +403,7 @@ _ <- printName r <- getResult handleResult r--- return (Any True, stats) , Any True)-{-- ( Traversal $ do- _ <- printName- r <- getResult- stats <- printResult r- return ()- , Any True- , stats- )-} foldHeading printHeading (printBody, Any nonempty) = (Ap $ do when nonempty $ printHeading@@ -440,11 +487,6 @@ Statistics s1 ug1 cg1 f1 `mappend` Statistics s2 ug2 cg2 f2 = Statistics (s1 + s2) (ug1 + ug2) (cg1 + cg2) (f1 + f2) mempty = Statistics 0 0 0 0 -{-computeStatistics :: StatusMap -> IO Statistics-computeStatistics = getApp . foldMap (\var -> Ap $- (\r -> Statistics 1 (if resultSuccessful r then 0 else 1))- <$> getResultFromTVar var)-}- printStatistics :: (?colors :: Bool) => Statistics -> Time -> IO () printStatistics st time = do printf "\n"@@ -543,8 +585,8 @@ gr <- atomically $ readTVar gmap case nm `M.lookup` gr of- Just g@(GRDifferent {}) -> return (r, RInteract g)- Just g@(GRNoGolden {}) -> return (r, RInteract g)+ Just g@(GRDifferent {}) -> return (r, RMismatch g)+ Just g@(GRNoGolden {}) -> return (r, RMismatch g) _ | resultSuccessful r -> return (r, RPass) _ | otherwise -> return (r, RFail) where statusVar =
Test/Tasty/Silver/Internal.hs view
@@ -107,7 +107,7 @@ cmp' <- cmp ref new case cmp' of Equal -> return (testPassed "", GREqual)- d -> let r = fromMaybe "Result did not match expected output. Use interactive mode (-i) to see full output." (gReason d)+ d -> let r = fromMaybe "Result did not match golden value." (gReason d) in return (testFailed r, GRDifferent ref new cmp' upd) forceGoldenResult :: GoldenResult -> IO GoldenResultI
tasty-silver.cabal view
@@ -1,5 +1,5 @@ name: tasty-silver-version: 3.1.1+version: 3.1.2 synopsis: Golden tests support for tasty. Fork of tasty-golden. description: This package provides support for «golden testing».