tasty-silver (empty) → 3.0
raw patch · 9 files changed
+779/−0 lines, 9 filesdep +asyncdep +basedep +bytestringsetup-changed
Dependencies added: async, base, bytestring, containers, deepseq, directory, filepath, mtl, optparse-applicative, process, process-extras, tagged, tasty, tasty-hunit, tasty-silver, temporary-rc, text
Files
- CHANGELOG.md +73/−0
- LICENSE +19/−0
- Setup.hs +2/−0
- Test/Tasty/Silver.hs +193/−0
- Test/Tasty/Silver/Advanced.hs +82/−0
- Test/Tasty/Silver/Internal.hs +97/−0
- Test/Tasty/Silver/Manage.hs +212/−0
- tasty-silver.cabal +72/−0
- tests/test.hs +29/−0
+ CHANGELOG.md view
@@ -0,0 +1,73 @@+Changes+=======++Version 2.2.2.4+---------------++* Warn when some tests threw exceptions during `--accept`+* Properly handle exceptions; don't swallow Ctrl-C++Version 2.2.2.3+---------------++Restore compatibility with older compilers++Version 2.2.2.1+---------------++Relax `Cabal` dependency++Version 2.2.2+-------------++Add `findByExtension`++Version 2.2.1.2+---------------++Catch exceptions when accepting golden tests++Version 2.2.1.1+---------------++Switch to `temporary-rc`++Version 2.2.1+-------------++* Fix a bug where the result of the comparison function would reference yet+ unread data from a semiclosed file and the file gets closed, leading to a+ runtime exception+* Export `writeBinaryFile`+* Improve the docs+* Update to work with `tasty-0.8`++Version 2.2.0.2+---------------++Update to work with `tasty-0.7`++Version 2.2.0.1+---------------++Update to work with `tasty-0.5`++Version 2.2+-----------++Migrate to ingredients++Version 2.1+-----------++Add `goldenVsStringDiff`++Version 2.0.1+-------------++Update to work with `tasty-0.2`++Version 2.0+-----------++Initial release of `tasty-golden` (derived from `test-framework-golden-1.1.x`)
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012 Roman Cheplyaka++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Tasty/Silver.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}+{- |+This module provides a simplified interface. If you want more, see "Test.Tasty.Golden.Advanced".++Note about filenames. They are looked up in the usual way, thus relative+names are relative to the processes current working directory.+It is common to run tests from the package's root directory (via @cabal+test@ or @cabal install --enable-tests@), so if your test files are under+the @tests\/@ subdirectory, your relative file names should start with+@tests\/@ (even if your @test.hs@ is itself under @tests\/@, too).++Note about line endings. The best way to avoid headaches with line endings+(when running tests both on UNIX and Windows) is to treat your golden files+as binary, even when they are actually textual.++This means:++* When writing output files from Haskell code, open them in binary mode+(see 'openBinaryFile', 'withBinaryFile' and 'hSetBinaryMode'). This will+disable automatic @\\n -> \\r\\n@ conversion on Windows. For convenience, this+module exports 'writeBinaryFile' which is just like `writeFile` but opens+the file in binary mode. When using 'ByteString's note that+"Data.ByteString" and "Data.ByteString.Lazy" use binary mode for+@writeFile@, while "Data.ByteString.Char8" and "Data.ByteString.Lazy.Char8"+use text mode.++* Tell your VCS not to do any newline conversion for golden files. For+ git check in a @.gitattributes@ file with the following contents (assuming+ your golden files have @.golden@ extension):++>*.golden -text++On its side, tasty-golden reads and writes files in binary mode, too.++Why not let Haskell/git do automatic conversion on Windows? Well, for+instance, @tar@ will not do the conversion for you when unpacking a release+tarball, so when you run @cabal install your-package --enable-tests@, the+tests will be broken.++As a last resort, you can strip all @\\r@s from both arguments in your+comparison function when necessary. But most of the time treating the files+as binary does the job.+-}++module Test.Tasty.Silver+ ( goldenVsFile+ , goldenVsProg+ , goldenVsAction++ , printProcResult++ , writeBinaryFile+ , findByExtension+ )+ where++import Test.Tasty.Providers+import Test.Tasty.Silver.Advanced+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as BS+import System.Exit+import Control.Applicative+import qualified Data.Text as T+import System.Process.Text as PT+import System.Directory+import System.FilePath+import qualified Data.Set as Set+import Control.Monad+import System.IO++-- trick to avoid an explicit dependency on transformers+import Control.Monad.Error (liftIO)+import Data.Text.Encoding+++-- | Compare a given file contents against the golden file contents. Assumes that both text files are utf8 encoded.+goldenVsFile+ :: TestName -- ^ test name+ -> FilePath -- ^ path to the «golden» file (the file that contains correct output)+ -> FilePath -- ^ path to the output file+ -> 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 =+ goldenTest1+ name+ (maybe Nothing (Just . decodeUtf8 . BL.toStrict) <$> vgReadFileMaybe ref)+ (liftIO act >> (decodeUtf8 . BL.toStrict <$> vgReadFile new))+ textLikeDiff+ textLikeShow+ (upd)+ where upd = BS.writeFile ref . encodeUtf8++-- | Compares a given file with the output (exit code, stdout, stderr) of a program. Assumes+-- that the program output is utf8 encoded.+goldenVsProg+ :: TestName -- ^ test name+ -> FilePath -- ^ path to the golden file+ -> FilePath -- ^ executable to run.+ -> [String] -- ^ arguments to pass.+ -> T.Text -- ^ stdin+ -> TestTree+goldenVsProg name ref cmd args inp =+ goldenVsAction name ref runProg printProcResult+ where runProg = PT.readProcessWithExitCode cmd args inp++-- | Compare something text-like against the golden file contents.+-- For the conversion of inputs to text you may want to use the Data.Text.Encoding+-- or/and System.Process.Text modules.+goldenVsAction+ :: TestName -- ^ test name+ -> FilePath -- ^ path to the «golden» file (the file that contains correct output)+ -> IO a -- ^ action that returns a text-like value.+ -> (a -> T.Text) -- ^ Converts a value to it's textual representation.+ -> TestTree -- ^ the test verifies that the returned textual representation+ -- is the same as the golden file contents+goldenVsAction name ref act toTxt =+ goldenTest1+ name+ (maybe Nothing (Just . decodeUtf8 . BL.toStrict) <$> vgReadFileMaybe ref)+ (liftIO (toTxt <$> act))+ textLikeDiff+ textLikeShow+ (upd . BL.fromStrict . encodeUtf8)+ where upd = BL.writeFile ref++textLikeShow :: T.Text -> GShow+textLikeShow = ShowText++textLikeDiff :: T.Text -> T.Text -> GDiff+textLikeDiff x y | x == y = Equal+textLikeDiff x y | otherwise = DiffText x y+++-- | Converts the output of a process produced by e.g. System.Process.Text to a textual representation.+-- Stdout/stderr are written seperately, any ordering relation between the two streams+-- is lost in the translation.+printProcResult :: (ExitCode, T.Text, T.Text) -> T.Text+-- first line is exit code, then out block, then err block+printProcResult (ex, a, b) = T.unlines (["ret > " `T.append` T.pack (show ex)]+ ++ addPrefix "out >" a ++ addPrefix "err >" b)+ where addPrefix _ t | T.null t = []+ addPrefix pref t | otherwise = map (f pref) (T.splitOn "\n" t)+ -- don't add trailing whitespace if line is empty. git diff will mark trailing whitespace+ -- as error, which looks distracting.+ f pref ln | T.null ln = pref+ f pref ln | otherwise = pref `T.append` " " `T.append` ln++++-- | Like 'writeFile', but uses binary mode+writeBinaryFile :: FilePath -> String -> IO ()+writeBinaryFile f txt = withBinaryFile f WriteMode (\hdl -> hPutStr hdl txt)++-- | Find all files in the given directory and its subdirectories that have+-- the given extensions.+--+-- It is typically used to find all test files and produce a golden test+-- per test file.+--+-- The returned paths use forward slashes to separate path components,+-- even on Windows. Thus if the file name ends up in a golden file, it+-- will not differ when run on another platform.+--+-- The semantics of extensions is the same as in 'takeExtension'. In+-- particular, non-empty extensions should have the form @".ext"@.+--+-- This function may throw any exception that 'getDirectoryContents' may+-- throw.+--+-- It doesn't do anything special to handle symlinks (in particular, it+-- probably won't work on symlink loops).+--+-- Nor is it optimized to work with huge directory trees (you'd probably+-- want to use some form of coroutines for that).+findByExtension+ :: [FilePath] -- ^ extensions+ -> FilePath -- ^ directory+ -> IO [FilePath] -- ^ paths+findByExtension extsList = go where+ exts = Set.fromList extsList+ go dir = do+ allEntries <- getDirectoryContents dir+ let entries = filter (not . (`elem` [".", ".."])) allEntries+ liftM concat $ forM entries $ \e -> do+ let path = dir ++ "/" ++ e+ isDir <- doesDirectoryExist path+ if isDir+ then go path+ else+ return $+ if takeExtension path `Set.member` exts+ then [path]+ else []
+ Test/Tasty/Silver/Advanced.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE RankNTypes, OverloadedStrings #-}+module Test.Tasty.Silver.Advanced+ ( -- * The main function+ goldenTest1,++ goldenTestIO,+ goldenTest,++ GShow (..),+ GDiff (..),++ -- * ValueGetter monad+ ValueGetter(..),+ vgReadFile,+ vgReadFileMaybe+ )+where++import Test.Tasty.Providers+import Test.Tasty.Silver.Internal+import Control.Applicative+import qualified Data.Text as T++-- | A very general testing function. Use 'goldenTest1' instead if you can.+goldenTest+ :: TestName -- ^ test name+ -> (forall r . ValueGetter r a) -- ^ get the golden correct value+ -> (forall r . ValueGetter r a) -- ^ get the tested value+ -> (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+ -> TestTree+goldenTest t golden test cmp upd = goldenTestIO t (Just <$> golden) test runCmp shw upd+ where -- the diff should behave in a pure way, so let's just use unsafePerformIO+ runCmp a b = do+ cmp' <- cmp a b+ case cmp' of+ Just d -> return $ ShowDiffed $ T.pack d+ Nothing -> return Equal+ shw _ = return $ ShowText "Old API does not support showing the actual value. Use the --accept mode or use the new API."+++-- | A very general testing function.+goldenTest1+ :: TestName -- ^ test name+ -> (forall r . ValueGetter r (Maybe a)) -- ^ get the golden correct value+ -> (forall r . ValueGetter r a) -- ^ get the tested value+ -> (a -> a -> GDiff)+ -- ^ comparison function.+ --+ -- If two values are the same, it should return 'Equal'. If they are+ -- different, it should return a diff representation.+ -- First argument is golden value.+ -> (a -> GShow) -- ^ Show the golden/actual value.+ -> (a -> IO ()) -- ^ update the golden file+ -> TestTree+goldenTest1 t golden test diff shw upd = goldenTestIO t golden test (\a b -> return $ diff a b) (return . shw) upd++-- | A very general testing function.+-- The IO version of show/diff are useful when using external diff or show mechanisms. If IO is not required,+-- the `goldenTest1` function should be used instead.+goldenTestIO+ :: TestName -- ^ test name+ -> (forall r . ValueGetter r (Maybe a)) -- ^ get the golden correct value+ -> (forall r . ValueGetter r a) -- ^ get the tested value+ -> (a -> a -> IO GDiff)+ -- ^ comparison function.+ --+ -- If two values are the same, it should return 'Equal'. If they are+ -- different, it should return a diff representation.+ -- First argument is golden value.+ -> (a -> IO GShow) -- ^ Show the golden/actual value.+ -> (a -> IO ()) -- ^ update the golden file+ -> TestTree+goldenTestIO t golden test diff shw upd = singleTest t $ Golden golden test diff shw upd
+ Test/Tasty/Silver/Internal.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE RankNTypes, ExistentialQuantification, DeriveDataTypeable,+ MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}+module Test.Tasty.Silver.Internal where++import Control.Applicative+import Control.Monad.Cont+import Control.Exception+import Data.Typeable (Typeable)+import Data.ByteString.Lazy as LB+import System.IO+import System.IO.Error+import Test.Tasty.Providers+import qualified Data.Text as T+import Data.Maybe++-- | See 'goldenTest1' for explanation of the fields+data Golden =+ forall a .+ Golden+ (forall r . ValueGetter r (Maybe a)) -- Get golden value.+ (forall r . ValueGetter r a) -- Get actual value.+ (a -> a -> IO GDiff) -- Compare/diff.+ (a -> IO GShow) -- How to produce a show.+ (a -> IO ()) -- Update golden value.+ deriving Typeable++-- | An action that yields a value (either golden or tested).+--+-- CPS allows closing the file handle when using lazy IO to read data.+newtype ValueGetter r a = ValueGetter+ { runValueGetter :: ContT r IO a }+ deriving (Functor, Applicative, Monad, MonadCont, MonadIO)++-- | Lazily read a file. The file handle will be closed after the+-- 'ValueGetter' action is run.+vgReadFile :: FilePath -> ValueGetter r ByteString+vgReadFile path = fromJust <$> vgReadFile1 predFalse path+ where predFalse :: IOException -> Bool+ predFalse _ = False++-- | Lazily read a file. The file handle will be closed after the+-- 'ValueGetter' action is run.+-- Will return 'Nothing' if the file does not exist.+vgReadFileMaybe :: FilePath -> ValueGetter r (Maybe ByteString)+vgReadFileMaybe = vgReadFile1 (isDoesNotExistErrorType . ioeGetErrorType)+++-- | Reads a file, and optionally catches some exceptions. If+-- an exception is catched, Nothing is returned.+vgReadFile1 :: Exception e+ => (e -> Bool) -- ^ Which exceptions to catch.+ -> FilePath+ -> ValueGetter r (Maybe ByteString)+vgReadFile1 doCatch path = do+ r <- ValueGetter $+ ContT $ \k ->+ catchJust (\e -> if doCatch e then Just () else Nothing)+ (bracket+ (openBinaryFile path ReadMode)+ hClose+ (\h -> LB.hGetContents h >>= (k . Just))+ )+ (const $ k Nothing)+ return $! r++-- | Ensures that the result is fully evaluated (so that lazy file handles+-- can be closed)+vgRun :: ValueGetter r r -> IO r+vgRun (ValueGetter a) = runContT a evaluate++-- | The comparison/diff result.+data GDiff+ = Equal -- ^ Values are equal.+ | DiffText { gActual :: T.Text, gExpected :: T.Text } -- ^ The two values are different, show a diff between the two given texts.+ | ShowDiffed { gDiff :: T.Text } -- ^ The two values are different, just show the given text to the user.++-- | How to show a value to the user.+data GShow+ = ShowText T.Text -- ^ Show the given text.++instance IsTest Golden where+ run _ golden _ = runGolden golden+ testOptions = return []++runGolden :: Golden -> IO Result+runGolden (Golden getGolden getActual cmp _ _) = do+ vgRun $ do+ new <- getActual+ ref' <- getGolden+ case ref' of+ Nothing -> return $ testFailed "Missing golden value."+ Just ref -> do+ -- Output could be arbitrarily big, so don't even try to say what wen't wrong.+ cmp' <- liftIO $ cmp ref new+ case cmp' of+ Equal -> return $ testPassed ""+ _ -> return $ testFailed "Result did not match expected output. Use interactive mode to see the full output."
+ Test/Tasty/Silver/Manage.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-}+-- | Golden test management+module Test.Tasty.Silver.Manage+ (+ -- * Command line helpers+ defaultMain++ -- * The ingredient+ , acceptingTests+ , AcceptTests(..)++ -- * Programmatic API+ , acceptGoldenTests+ )+ where++import Test.Tasty hiding (defaultMain)+import Test.Tasty.Runners+import Test.Tasty.Options+import Test.Tasty.Silver.Internal+import Data.Typeable+import Data.Tagged+import Data.Proxy+import Data.Maybe+import Control.Monad.Cont+import Control.Monad.State+import Control.Exception+import Control.Concurrent.Async+import Text.Printf+import qualified Data.Text as T+import Data.Text.Encoding+import Options.Applicative+import System.Process.ByteString.Lazy as PL+import System.Process+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString as BS+import System.IO+import System.IO.Temp+import System.FilePath++-- | Like @defaultMain@ from the main tasty package, but also includes the+-- golden test management capabilities.+defaultMain :: TestTree -> IO ()+defaultMain = defaultMainWithIngredients [interactiveTests, acceptingTests, listingTests, consoleTestReporter]++-- | This option, when set to 'True', specifies that we should run in the+-- «accept tests» mode+newtype AcceptTests = AcceptTests Bool+ deriving (Eq, Ord, Typeable)+instance IsOption AcceptTests where+ defaultValue = AcceptTests False+ parseValue = fmap AcceptTests . safeRead+ optionName = return "accept"+ optionHelp = return "Accept current results of golden tests"+ optionCLParser =+ fmap AcceptTests $+ switch+ ( long (untag (optionName :: Tagged AcceptTests String))+ <> help (untag (optionHelp :: Tagged AcceptTests String))+ )++newtype Interactive = Interactive Bool+ deriving (Eq, Ord, Typeable)+instance IsOption Interactive where+ defaultValue = Interactive False+ parseValue = fmap Interactive . safeRead+ optionName = return "interactive"+ optionHelp = return "Run tests in interactive mode."+ optionCLParser =+ fmap Interactive $+ switch+ ( long (untag (optionName :: Tagged Interactive String))+ <> help (untag (optionHelp :: Tagged Interactive String))+ )+++acceptingTests :: Ingredient+acceptingTests = TestManager [Option (Proxy :: Proxy AcceptTests)] $+ \opts tree ->+ case lookupOption opts of+ AcceptTests False -> Nothing+ AcceptTests True -> Just $+ acceptGoldenTests opts tree++interactiveTests :: Ingredient+interactiveTests = TestManager [Option (Proxy :: Proxy Interactive)] $+ \opts tree ->+ case lookupOption opts of+ Interactive False -> Nothing+ Interactive True -> Just $+ runTestsInteractive opts tree++-- | Get the list of all golden tests in a given test tree+getGoldenTests :: OptionSet -> TestTree -> [(TestName, Golden)]+getGoldenTests =+ foldTestTree+ trivialFold { foldSingle = \_ name t -> fmap ((,) name) $ maybeToList $ cast t }++-- | «Accept» a golden test, i.e. reset the golden value to the currently+-- produced value+acceptGoldenTest :: Golden -> IO ()+acceptGoldenTest (Golden _ getTested _ _ update) =+ vgRun $ liftIO . update =<< getTested++-- | Accept all golden tests in the test tree+acceptGoldenTests :: OptionSet -> TestTree -> IO Bool+acceptGoldenTests opts tests = do+ let gs = getGoldenTests opts tests+ numExns <- flip execStateT (0 :: Int) $ forM_ gs $ \(n,g) -> do+ mbExn <- liftIO $ withAsync (acceptGoldenTest g) waitCatch+ case mbExn of+ Right {} -> liftIO $ printf "Accepted %s\n" n+ Left e -> do+ _ <- liftIO $ printf "Error when trying to accept %s: %s\n" n (show (e :: SomeException))+ ne <- get+ put $! ne+1++ -- warn when there were problems+ when (numExns > 0) $+ printf "NOTE: %d tests threw exceptions!\n" numExns+ -- is everything ok?+ return (numExns == 0)++-- | Run in interactive mode (only tested on linux)+runTestsInteractive :: OptionSet -> TestTree -> IO Bool+runTestsInteractive opts tests = do+ let gs = getGoldenTests opts tests++ liftIO $ hSetBuffering stdout NoBuffering++ (nFail, nReject) <- flip execStateT (0, 0) $ forM_ gs runTest++ -- warn when there were problems+ when (nFail > 0 || nReject > 0) (do+ _ <- printf "NOTE: %d tests threw exceptions!\n" nFail+ printf "NOTE: %d tests were rejected!\n" nReject+ )++ -- is everything ok?+ return (nFail == 0 && nReject == 0)+ where runTest :: (TestName, Golden) -> StateT (Integer, Integer) IO ()+ runTest (n, (Golden getGolden getActual cmp shw upd)) = do+ -- execute test+ liftIO $ putStrLn "Executing test"++ -- we can't run any update inside the vg monad,+ -- as the golden file might still be open+ (pFail, pReject, act) <- liftIO $ vgRun $ do+ tested <- getActual++ -- read golden+ liftIO $ putStrLn "Getting golden"+ golden <- getGolden+ case golden of+ Nothing -> do+ _ <- liftIO $ printf "%s: No golden value. Press <enter> to see actual value.\n" n+ _ <- liftIO getLine+ _ <- liftIO $ shw tested >>= showValue n+ liftIO $ tryAccept n upd tested+ Just golden' -> do+ cmp' <- liftIO $ cmp golden' tested+ case cmp' of+ Equal -> do+ _ <- liftIO $ printf "%s: Golden value matches output.\n" n+ return (0, 0, return ())+ diff' -> do+ _ <- liftIO $ printf "%s: Output does not match golden value. Press <enter> to see diff.\n" n+ _ <- liftIO getLine+ _ <- liftIO $ showDiff n diff'+ liftIO $ tryAccept n upd tested+ -- now execute update+ liftIO act+ modify (\(nFail, nReject) -> (nFail + pFail, nReject + pReject))++ tryAccept :: TestName -> (a -> IO ()) -> a -> IO (Integer, Integer, IO ())+ tryAccept n upd new = do+ _ <- printf "%s: Accept actual value as new golden value? [yn]" n+ ans <- getLine+ case ans of+ "y" -> do+ return (0, 0, upd new)+ "n" -> return (0, 1, return ())+ _ -> do+ putStrLn "Invalid answer."+ tryAccept n upd new++showDiff :: TestName -> GDiff -> IO ()+showDiff n (DiffText tGold tAct) = do+ withSystemTempFile (n <.> "golden") (\fGold hGold -> do+ withSystemTempFile (n <.> "actual") (\fAct hAct -> do+ hSetBinaryMode hGold True+ hSetBinaryMode hAct True+ BS.hPut hGold (encodeUtf8 tGold)+ 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"]+ )+ )+showDiff n (ShowDiffed t) = showInLess n t+showDiff _ Equal = error "Can't show diff for equal values..."++showValue :: TestName -> GShow -> IO ()+showValue n (ShowText t) = showInLess n t++showInLess :: String -> T.Text -> IO ()+showInLess _ t = do+ -- TODO error handling...+ _ <- PL.readProcessWithExitCode "sh" ["-c", "less > /dev/tty"] inp+ return ()+ where inp = B.fromStrict $ encodeUtf8 t
+ tasty-silver.cabal view
@@ -0,0 +1,72 @@+name: tasty-silver+version: 3.0+synopsis: Golden tests support for tasty. Fork of tasty-golden.+description:+ This package provides support for «golden testing».++ A golden test is an IO action that writes its result to a file.+ To pass the test, this output file should be identical to the corresponding+ «golden» file, which contains the correct result for the test.++license: MIT+license-file: LICENSE+Homepage: https://github.com/feuerbach/tasty-golden+Bug-reports: https://github.com/feuerbach/tasty-golden/issues+author: Roman Cheplyaka, Philipp Hausmann and others+maintainer: Philipp Hausmann+-- copyright: +category: Testing+build-type: Simple+cabal-version: >=1.14+extra-source-files: CHANGELOG.md++--Source-repository head+-- type: git+-- location: git://github.com/feuerbach/tasty-golden.git++library+ Default-language:+ Haskell2010+ exposed-modules: Test.Tasty.Silver+ Test.Tasty.Silver.Advanced+ Test.Tasty.Silver.Manage+ other-modules:+ Test.Tasty.Silver.Internal++ ghc-options: -Wall++ build-depends:+ base ==4.*,+ tasty >= 0.8,+ bytestring,+ process >= 1.2 && < 1.3,+ mtl,+ optparse-applicative,+ filepath,+ temporary-rc,+ tagged,+ deepseq,+ containers,+ directory,+ async,+ text >= 0.11.0.0 && < 1.3,+ process-extras >= 0.2 && < 0.3++Test-suite test+ Default-language:+ Haskell2010+ Type:+ exitcode-stdio-1.0+ Hs-source-dirs:+ tests+ Main-is:+ test.hs+ Build-depends:+ base >= 4 && < 5+ , tasty >= 0.8+ , tasty-hunit+ , tasty-silver+ , filepath+ , directory+ , process+ , temporary-rc
+ tests/test.hs view
@@ -0,0 +1,29 @@+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Silver+import System.IO.Temp+import System.FilePath+import System.Directory+import Data.List (sort)++touch f = writeFile f ""++main = defaultMain $+ testCase "findByExtension" $+ withSystemTempDirectory "golden-test" $ \basedir -> do++ setCurrentDirectory basedir++ createDirectory ("d1")+ createDirectory ("d1" </> "d2")+ touch ("f1.c")+ touch ("f2.h")+ touch ("f2.exe")+ touch ("d1" </> "g1.c")+ touch ("d1" </> "d2" </> "h1.c")+ touch ("d1" </> "d2" </> "h1.exe")+ touch ("d1" </> "d2" </> "h1")++ files <- findByExtension [".c", ".h"] "."+ sort files @?= sort+ ["./d1/d2/h1.c","./d1/g1.c","./f1.c","./f2.h"]