diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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`) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/Tasty/Silver.hs b/Test/Tasty/Silver.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/Silver.hs @@ -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 [] diff --git a/Test/Tasty/Silver/Advanced.hs b/Test/Tasty/Silver/Advanced.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/Silver/Advanced.hs @@ -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 diff --git a/Test/Tasty/Silver/Internal.hs b/Test/Tasty/Silver/Internal.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/Silver/Internal.hs @@ -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." diff --git a/Test/Tasty/Silver/Manage.hs b/Test/Tasty/Silver/Manage.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/Silver/Manage.hs @@ -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 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 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 diff --git a/tasty-silver.cabal b/tasty-silver.cabal new file mode 100644 --- /dev/null +++ b/tasty-silver.cabal @@ -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 diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 --- /dev/null +++ b/tests/test.hs @@ -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"]