diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ Changes ======= +Version 2.3.4 +------------- + +* Add an option to remove the output file after a test has run, if there is + a golden file, or one has been created + Version 2.3.3.3 --------------- diff --git a/Test/Tasty/Golden.hs b/Test/Tasty/Golden.hs --- a/Test/Tasty/Golden.hs +++ b/Test/Tasty/Golden.hs @@ -47,11 +47,16 @@ {-# LANGUAGE OverloadedStrings #-} module Test.Tasty.Golden - ( goldenVsFile + ( + -- * Functions to create a golden test + goldenVsFile , goldenVsString , goldenVsFileDiff , goldenVsStringDiff + -- * Options , SizeCutoff(..) + , DeleteOutputFile(..) + -- * Various utilities , writeBinaryFile , findByExtension , createDirectoriesAndWriteFile @@ -86,15 +91,17 @@ -> IO () -- ^ action that creates the output file -> TestTree -- ^ the test verifies that the output file contents is the same as the golden file contents goldenVsFile name ref new act = - goldenTest + goldenTest2 name (readFileStrict ref) (act >> readFileStrict new) cmp upd + del where cmp = simpleCmp $ printf "Files '%s' and '%s' differ" ref new upd = createDirectoriesAndWriteFile ref + del = removeFile new -- | Compare a given string against the golden file's contents. goldenVsString @@ -137,7 +144,7 @@ -> TestTree goldenVsFileDiff name cmdf ref new act = askOption $ \sizeCutoff -> - goldenTest + goldenTest2 name (getFileStatus ref >> return ()) -- Use getFileStatus to check if the golden file exists. If the file @@ -147,6 +154,7 @@ act (cmp sizeCutoff) upd + del where cmd = cmdf ref new cmp sizeCutoff _ _ @@ -162,6 +170,7 @@ _ -> Just . unpackUtf8 . truncateLargeOutput sizeCutoff $ out upd _ = readFileStrict new >>= createDirectoriesAndWriteFile ref + del = removeFile new -- | Same as 'goldenVsString', but invokes an external diff command. goldenVsStringDiff @@ -217,7 +226,8 @@ LBS.take n str <> "" <> "\nUse --accept or increase --size-cutoff to see full output." --- | Like 'writeFile', but uses binary mode. +-- | Like 'writeFile', but uses binary mode. (Needed only when you work +-- with 'String'.) writeBinaryFile :: FilePath -> String -> IO () writeBinaryFile f txt = withBinaryFile f WriteMode (\hdl -> hPutStr hdl txt) @@ -262,7 +272,7 @@ then [path] else [] --- | Like 'BS.writeFile', but also create parent directories if they are +-- | Like 'LBS.writeFile', but also create parent directories if they are -- missing. createDirectoriesAndWriteFile :: FilePath diff --git a/Test/Tasty/Golden/Advanced.hs b/Test/Tasty/Golden/Advanced.hs --- a/Test/Tasty/Golden/Advanced.hs +++ b/Test/Tasty/Golden/Advanced.hs @@ -1,7 +1,8 @@ {-# LANGUAGE RankNTypes #-} module Test.Tasty.Golden.Advanced - ( -- * The main function - goldenTest + ( -- * The main functions + goldenTest, + goldenTest2 ) where @@ -32,4 +33,37 @@ -> (a -> IO ()) -- ^ update the golden file -> TestTree -goldenTest t golden test cmp upd = singleTest t $ Golden golden test cmp upd +goldenTest t golden test cmp upd = singleTest t $ Golden golden test cmp upd (return ()) + +-- | A variant of 'goldenTest' that also provides for deleting the output +-- file. The 'Internal.DeleteOuputFile' option controls the circumstances in which +-- the output file is to be deleted. +-- +-- @since 2.3.4 +goldenTest2 + :: TestName -- ^ Test name + -> IO a + -- ^ Get the golden correct value + -- + -- Note that this action may be followed by the update function call. + -- + -- Therefore, this action *should avoid* reading the file lazily; + -- otherwise, the file may remain half-open and the update action will + -- fail. + -> IO a + -- ^ Get the tested value (in this case from the output file) + -> (a -> a -> IO (Maybe String)) + -- ^ Comparison function. + -- + -- If two values are the same, it should return 'Nothing'. If they are + -- different, it should return an error that will be printed to the user. + -- First argument is the golden value. + -- + -- The function may use 'IO', for example, to launch an external @diff@ + -- command. + -> (a -> IO ()) + -- ^ Update the golden file + -> IO () + -- ^ Action to delete the output file + -> TestTree +goldenTest2 t golden test cmp upd del = singleTest t $ Golden golden test cmp upd del diff --git a/Test/Tasty/Golden/Internal.hs b/Test/Tasty/Golden/Internal.hs --- a/Test/Tasty/Golden/Internal.hs +++ b/Test/Tasty/Golden/Internal.hs @@ -4,9 +4,11 @@ import Control.DeepSeq import Control.Exception +import Control.Monad (when) import Data.Typeable (Typeable) import Data.Proxy import Data.Int +import Data.Char (toLower) import System.IO.Error (isDoesNotExistError) import Options.Applicative (metavar) import Test.Tasty.Providers @@ -23,6 +25,7 @@ (IO a) (a -> a -> IO (Maybe String)) (a -> IO ()) + (IO ()) deriving Typeable -- | This option, when set to 'True', specifies that we should run in the @@ -62,6 +65,45 @@ optionHelp = return "hide golden test output if it's larger than n bytes" optionCLParser = mkOptionCLParser $ metavar "n" +-- | When / whether to delete the test output file, +-- when there is a golden file +-- +-- @since 2.3.4 +data DeleteOutputFile + = Never -- ^ Never delete the output file (default) + | OnPass -- ^ Delete the output file if the test passes + | Always -- ^ Always delete the output file. (May not be commonly used, + -- but provided for completeness.) + deriving (Eq, Ord, Typeable, Show) + +-- | This option controls when / whether the test output file is deleted +-- For example, it may be convenient to delete the output file when a test +-- passes, since it will be the same as the golden file. +-- +-- It does nothing if +-- +-- * running the test or accessing an existing golden value threw an exception. +-- +-- * there is no golden file for the test +instance IsOption DeleteOutputFile where + defaultValue = Never + parseValue = parseDeleteOutputFile + optionName = return "delete-output" + optionHelp = return "If there is a golden file, when to delete output files" + showDefaultValue = Just . displayDeleteOutputFile + optionCLParser = mkOptionCLParser $ metavar "never|onpass|always" + +parseDeleteOutputFile :: String -> Maybe DeleteOutputFile +parseDeleteOutputFile s = + case map toLower s of + "never" -> Just Never + "onpass" -> Just OnPass + "always" -> Just Always + _ -> Nothing + +displayDeleteOutputFile :: DeleteOutputFile -> String +displayDeleteOutputFile dof = map toLower (show dof) + instance IsTest Golden where run opts golden _ = runGolden golden opts testOptions = @@ -69,11 +111,12 @@ [ Option (Proxy :: Proxy AcceptTests) , Option (Proxy :: Proxy NoCreateFile) , Option (Proxy :: Proxy SizeCutoff) + , Option (Proxy :: Proxy DeleteOutputFile) ] runGolden :: Golden -> OptionSet -> IO Result -runGolden (Golden getGolden getTested cmp update) opts = do - do +runGolden (Golden getGolden getTested cmp update delete) opts = do + mbNew <- try getTested case mbNew of @@ -86,9 +129,13 @@ case mbRef of Left e | isDoesNotExistError e -> if noCreate - then return $ testFailed "Golden file does not exist; --no-create flag specified" + then + -- Don't ever delete the output file in this case, as there is + -- no duplicate golden file + return $ testFailed "Golden file does not exist; --no-create flag specified" else do update new + when (delOut `elem` [Always, OnPass]) delete return $ testPassed "Golden file did not exist; created" | otherwise -> throwIO e @@ -101,16 +148,20 @@ Just _reason | accept -> do -- test failed; accept the new version update new + when (delOut `elem` [Always, OnPass]) delete return $ testPassed "Accepted the new version" Just reason -> do -- Make sure that the result is fully evaluated and doesn't depend -- on yet un-read lazy input evaluate . rnf $ reason + when (delOut == Always) delete return $ testFailed reason - Nothing -> + Nothing -> do + when (delOut `elem` [Always, OnPass]) delete return $ testPassed "" where AcceptTests accept = lookupOption opts NoCreateFile noCreate = lookupOption opts + delOut = lookupOption opts diff --git a/tasty-golden.cabal b/tasty-golden.cabal --- a/tasty-golden.cabal +++ b/tasty-golden.cabal @@ -1,5 +1,5 @@ name: tasty-golden -version: 2.3.3.3 +version: 2.3.4 synopsis: Golden tests support for tasty description: This package provides support for «golden testing».