diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,14 @@ Changes ======= +Version 3.2.3 (13 Sep 2021) +------------- + +* Tested with GHC 7.4 - 9.0 (fixed compilation with GHC 7.4 - 7.8) +* CI via GitHub Actions on platforms `ubuntu`, `macOS`, `windows`. + Version 3.2.2 ---------------- +------------- * Fix cabal warning (#27, thanks to felixonmars) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,36 @@ +[![Hackage version](https://img.shields.io/hackage/v/tasty-silver.svg?label=Hackage)](http://hackage.haskell.org/package/tasty-silver) +[![tasty-silver on Stackage Nightly](https://stackage.org/package/tasty-silver/badge/nightly)](https://stackage.org/nightly/package/tasty-silver) +[![Stackage LTS version](https://www.stackage.org/package/tasty-silver/badge/lts?label=Stackage)](https://www.stackage.org/package/tasty-silver) +[![Haskell-CI](https://github.com/phile314/tasty-silver/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/phile314/tasty-silver/actions/workflows/haskell-ci.yml) +[![macOS](https://github.com/phile314/tasty-silver/actions/workflows/macOS.yml/badge.svg)](https://github.com/phile314/tasty-silver/actions/workflows/macOS.yml) +[![windows](https://github.com/phile314/tasty-silver/actions/workflows/windows.yml/badge.svg)](https://github.com/phile314/tasty-silver/actions/workflows/windows.yml) +[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/tasty-silver/badge)](https://matrix.hackage.haskell.org/package/tasty-silver) + +Tasty Silver +============ + +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. + +Interactive Mode +---------------- + +If the test runner is called with the `-i` option, the diff of any failing golden test is shown +to the user. Based upon this diff, the user can choose to update the golden standard or to +fix the test case as necessary. Interactive mode requires that at least `git diff` and `less` is +available, or preferrably `wdiff` and `colordiff` for character-based diffs. + +Examples +-------- + +For a non-trivial example see the [Agda tests](https://github.com/agda/agda/blob/master/test/Compiler/Tests.hs), +which is used for testing the Agda compiler. + +Maintainers +----------- + +[Philipp Hausmann](https://github.com/phile314) is the primary maintainer. +[Andreas Abel](https://github.com/andreasabel) is co-maintainer. diff --git a/Test/Tasty/Silver.hs b/Test/Tasty/Silver.hs --- a/Test/Tasty/Silver.hs +++ b/Test/Tasty/Silver.hs @@ -54,19 +54,22 @@ ) where -import Test.Tasty.Providers -import Test.Tasty.Silver.Advanced +import Control.Monad +#if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ( (<$>) ) +#endif import qualified Data.ByteString as BS -import System.Exit +import qualified Data.Set as Set import qualified Data.Text as T -import System.Process.Text as PT +import Data.Text.Encoding + import System.Directory +import System.Exit import System.FilePath -import qualified Data.Set as Set -import Control.Monad - -import Data.Text.Encoding +import System.Process.Text as PT +import Test.Tasty.Providers +import Test.Tasty.Silver.Advanced -- | Compare a given file contents against the golden file contents. Assumes that both text files are utf8 encoded. goldenVsFile diff --git a/Test/Tasty/Silver/Advanced.hs b/Test/Tasty/Silver/Advanced.hs --- a/Test/Tasty/Silver/Advanced.hs +++ b/Test/Tasty/Silver/Advanced.hs @@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes, OverloadedStrings #-} {-# LANGUAGE CPP #-} + module Test.Tasty.Silver.Advanced ( -- * The main function goldenTest1, @@ -15,6 +16,10 @@ readFileMaybe ) where + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ( (<$>) ) +#endif import Test.Tasty.Providers import Test.Tasty.Silver.Internal diff --git a/Test/Tasty/Silver/Filter.hs b/Test/Tasty/Silver/Filter.hs --- a/Test/Tasty/Silver/Filter.hs +++ b/Test/Tasty/Silver/Filter.hs @@ -1,10 +1,13 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} + -- | Regex filtering for test trees. module Test.Tasty.Silver.Filter ( filterWithRegex @@ -17,18 +20,24 @@ where import Prelude hiding (fail) -import Test.Tasty hiding (defaultMain) -import Test.Tasty.Runners -import Test.Tasty.Options + +import Data.Maybe +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup ( (<>) ) +#endif import Data.Tagged import Data.Typeable -import Data.Maybe -import Data.Monoid import qualified Data.List as L + import Options.Applicative + import qualified Text.Regex.TDFA.String as RS import qualified Text.Regex.TDFA as R +import Test.Tasty hiding (defaultMain) +import Test.Tasty.Options +import Test.Tasty.Runners + type TestPath = String -- we have to store the regex as String, as there is no Typeable instance @@ -121,4 +130,3 @@ filter' pth (AskOptions t) = Just $ AskOptions (\o -> fromMaybe emptyTest (filter' pth (t o))) emptyTest = testGroup "" [] - 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 @@ -1,13 +1,17 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} + -- | Golden test management, interactive mode. Runs the tests, and asks -- the user how to proceed in case of failure or missing golden standard. + module Test.Tasty.Silver.Interactive ( -- * Command line helpers @@ -24,42 +28,54 @@ where import Prelude hiding (fail) -import Test.Tasty hiding (defaultMain) -import Test.Tasty.Runners -import Test.Tasty.Options -import Test.Tasty.Silver.Filter -import Test.Tasty.Silver.Internal -import Test.Tasty.Silver.Interactive.Run -import Data.Typeable -import Data.Tagged + +import Control.Concurrent.STM.TVar +import Control.Exception +import Control.Monad.Identity hiding (fail) +import Control.Monad.Reader hiding (fail) +import Control.Monad.STM +import Control.Monad.State hiding (fail) + +import Data.Char import Data.Maybe import Data.Monoid ( Any(..) ) +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid ( Monoid(..) ) +#endif +import Data.Proxy +#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) -import qualified Data.Text.IO as TIO -import Data.Char +#endif +import Data.Tagged +import Data.Text.Encoding +import Data.Typeable +import qualified Data.ByteString as BS import qualified Data.IntMap as IntMap -import Control.Monad.State hiding (fail) -import Control.Monad.STM -import Control.Monad.Reader hiding (fail) -import Control.Monad.Identity hiding (fail) -import Control.Concurrent.STM.TVar -import Control.Exception -import Text.Printf import qualified Data.Text as T -import Data.Text.Encoding +import qualified Data.Text.IO as TIO + import Options.Applicative hiding (Failure, Success) -import System.Process.ByteString as PS -import System.Process -import qualified Data.ByteString as BS + +import System.Console.ANSI import System.Directory import System.Exit +import System.FilePath import System.IO import System.IO.Temp -import System.FilePath -import Test.Tasty.Providers -import System.Console.ANSI +import System.Process +import System.Process.ByteString as PS import qualified System.Process.Text as PTL +import Text.Printf + +import Test.Tasty hiding (defaultMain) +import Test.Tasty.Options +import Test.Tasty.Providers +import Test.Tasty.Runners +import Test.Tasty.Silver.Filter +import Test.Tasty.Silver.Interactive.Run +import Test.Tasty.Silver.Internal + type DisabledTests = TestPath -> Bool -- | Like @defaultMain@ from the main tasty package, but also includes the @@ -118,7 +134,7 @@ Just $ runTestsInteractive dis opts (filterWithRegex opts tree) runSingleTest :: IsTest t => DisabledTests -> TestPath -> TestName -> OptionSet -> t -> (Progress -> IO ()) -> IO Result -runSingleTest dis tp _ _ _ _ | dis tp = +runSingleTest dis tp _ _ _ _ | dis tp = return $ (testFailed "") { resultOutcome = (Failure $ TestThrewException $ toException Disabled) } runSingleTest _ _ _ opts t cb = do @@ -584,7 +600,7 @@ instance Semigroup Statistics where Statistics a1 b1 c1 d1 e1 <> Statistics a2 b2 c2 d2 e2 = Statistics (a1 + a2) (b1 + b2) (c1 + c2) (d1 + d2) (e1 + e2) - + instance Monoid Statistics where mempty = Statistics 0 0 0 0 0 diff --git a/Test/Tasty/Silver/Internal.hs b/Test/Tasty/Silver/Internal.hs --- a/Test/Tasty/Silver/Internal.hs +++ b/Test/Tasty/Silver/Internal.hs @@ -1,23 +1,31 @@ -{-# LANGUAGE RankNTypes, ExistentialQuantification, DeriveDataTypeable, - MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} + module Test.Tasty.Silver.Internal where import Control.Exception import Control.Monad.Identity -import Data.Typeable (Typeable) + import Data.ByteString as SB -import System.IO.Error -import qualified Data.Text as T -import Options.Applicative -import Data.Monoid -import Data.Tagged -import Data.Proxy +#if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ( (<$>) ) +#endif import Data.Maybe +import Data.Proxy +import Data.Typeable (Typeable) +import qualified Data.Text as T + +import System.IO.Error + import Test.Tasty.Providers import Test.Tasty.Options --- | See 'goldenTest1' for explanation of the fields +-- | See 'goldenTest1' for explanation of the fields. + data Golden = forall a . Golden @@ -30,7 +38,8 @@ -- | This option, when set to 'True', specifies that we should run in the --- «accept tests» mode +-- «accept tests» mode. + newtype AcceptTests = AcceptTests Bool deriving (Eq, Ord, Typeable) instance IsOption AcceptTests where @@ -42,6 +51,7 @@ -- | Read the file if it exists, else return Nothing. -- Useful for reading golden files. + readFileMaybe :: FilePath -> IO (Maybe SB.ByteString) readFileMaybe path = catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing) @@ -50,12 +60,17 @@ -- | The comparison/diff result. + data GDiff - = Equal -- ^ Values are equal. - | DiffText { gReason :: (Maybe String), gActual :: T.Text, gExpected :: T.Text } -- ^ The two values are different, show a diff between the two given texts. - | ShowDiffed { gReason :: (Maybe String), gDiff :: T.Text } -- ^ The two values are different, just show the given text to the user. + = Equal + -- ^ Values are equal. + | DiffText { gReason :: (Maybe String), gActual :: T.Text, gExpected :: T.Text } + -- ^ The two values are different, show a diff between the two given texts. + | ShowDiffed { gReason :: (Maybe String), 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. diff --git a/tasty-silver.cabal b/tasty-silver.cabal --- a/tasty-silver.cabal +++ b/tasty-silver.cabal @@ -1,5 +1,5 @@ name: tasty-silver -version: 3.2.2 +version: 3.2.3 synopsis: A fancy test runner, including support for golden tests. description: This package provides a fancy test runner and support for «golden testing». @@ -18,14 +18,30 @@ 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 --- copyright: +maintainer: Philipp Hausmann, Andreas Abel +-- copyright: category: Testing build-type: Simple cabal-version: 1.14 -extra-source-files: CHANGELOG.md -tested-with: GHC == 8.0.1, GHC == 8.2.2, GHC == 8.6.1 +extra-source-files: + CHANGELOG.md + README.md + +tested-with: + GHC == 9.0.1 + GHC == 8.10.4 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 + GHC == 7.8.4 + GHC == 7.6.3 + GHC == 7.4.2 + -- GHC 7.0 is not supported by regex-tdfa, needing array >= 0.4 + Source-repository head type: git location: git://github.com/phile314/tasty-silver.git @@ -40,13 +56,17 @@ Test.Tasty.Silver.Interactive.Run Test.Tasty.Silver.Internal - if impl(ghc >= 8.2.2) - ghc-options: -Wall -Wcompat -Wno-name-shadowing + if impl(ghc >= 8.0) + ghc-options: + -Wall + -Wno-name-shadowing + -Wcompat build-depends: ansi-terminal >= 0.6.2.1, async, - base ==4.*, + base >= 4.5, + -- regex-tdfa has this lower bound on base, so we make it explicit here bytestring >= 0.9.2.1, containers, directory, @@ -62,7 +82,7 @@ tasty >= 1.4, temporary, text >= 0.11.0.0 - if !impl(ghc >= 8.0) + if impl(ghc < 8.0) build-depends: semigroups >= 0.18.3 Test-suite test @@ -82,5 +102,13 @@ , filepath , directory , process + , silently >= 1.2.5.1 + -- Andreas Abel, 2021-09-05, latest silently is today 1.2.5.1 , temporary , transformers >= 0.3 + + if impl(ghc >= 8.0) + ghc-options: + -Wall + -Wno-name-shadowing + -Wcompat diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -1,69 +1,96 @@ +{-# LANGUAGE CPP #-} + +import Control.Concurrent.MVar +import Control.Monad (unless) +import Control.Monad.IO.Class (liftIO) +import Data.List (sort) +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (mempty) +#endif + +import System.Directory +import System.FilePath +import System.IO.Silently (capture) +import System.IO.Temp + import Test.Tasty hiding (defaultMain) import Test.Tasty.HUnit -import Test.Tasty.Silver -import Test.Tasty.Silver.Interactive +import Test.Tasty.Options import Test.Tasty.Runners +import Test.Tasty.Silver import Test.Tasty.Silver.Advanced +import Test.Tasty.Silver.Filter (checkRF) +import Test.Tasty.Silver.Interactive import Test.Tasty.Silver.Internal -import Test.Tasty.Options -import Test.Tasty.Silver.Filter -import Data.Monoid -import System.IO.Temp -import System.FilePath -import System.Directory -import Data.List (sort) -import Control.Concurrent.MVar -import Control.Monad.IO.Class - +touch :: FilePath -> IO () touch f = writeFile f "" -main = defaultMain $ testGroup "tests" [testFindByExt, testWithResource, testCheckRF] - - +main :: IO () +main = defaultMain $ testGroup "tests" $ + testFindByExt : + testWithResource : + testCheckRF : + [] testFindByExt :: TestTree -testFindByExt = testCase "findByExtension" $ +testFindByExt = + 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.c") -- match touch ("d1" "d2" "h1.exe") touch ("d1" "d2" "h1") + touch ("d1" "g1.c") -- match + touch ("f1.c") -- match + touch ("f2.h") -- match + touch ("f2.exe") files <- findByExtension [".c", ".h"] "." sort files @?= sort - ["./d1/d2/h1.c","./d1/g1.c","./f1.c","./f2.h"] + [ "./d1/d2/h1.c" + , "./d1/g1.c" + , "./f1.c" + , "./f2.h" + ] +-- | Check if resources are properly initialized. testWithResource :: TestTree -testWithResource = testCase "withResource" $ do - -- check if resources are properly initialized - testRes <- newMVar False - let acq = newMVar True - free v = swapMVar v False >> return () - test = \v -> goldenTest1 "check res" (return Nothing) (liftIO $ testAction v) (\_ _ -> Equal) (\_ -> ShowText mempty) upd - upd x = assertBool "Incorrect result" x >> return () - testAction = \v -> v >>= readMVar >>= assertBool "Resource not initialized." >> return True - tree = withResource acq free test - - let r = tryIngredients [consoleTestReporter] (singleOption $ AcceptTests True) tree - case r of +testWithResource = + testCase "withResource" $ + case tryIngredients [consoleTestReporter] (singleOption $ AcceptTests True) tree of Just r' -> do - success <- r' + (out, success) <- capture r' + unless success $ putStr out assertBool "Test should succeed." success Nothing -> assertFailure "Test broken" + where + tree = withResource acq free test + -- Resource acquisition. + acq = newMVar True + -- Resource release. + free v = swapMVar v False >> return () + -- Test using resource. + test v = goldenTest1 "check res" + (return Nothing) -- get the golden value + (liftIO $ testAction v) -- get the tested value + (\ _ _ -> Equal) -- comparison function (always succeed) + (\ _ -> ShowText mempty) -- show the golden/actual value + (\ x -> assertBool "Incorrect result" x) -- update the golden file + -- Actual test: check whether the MVar contains True. + testAction v = do + assertBool "Resource not initialized." =<< readMVar =<< v + return True testCheckRF :: TestTree -testCheckRF = testGroup "Filter.checkRF" - [ testCase "empty1a" $ checkRF True [] "/" @?= True - , testCase "empty1b" $ checkRF False [] "/" @?= False - , testCase "empty2a" $ checkRF True [] "/sdfg" @?= True +testCheckRF = + testGroup "Filter.checkRF" + [ testCase "empty1a" $ checkRF True [] "/" @?= True + , testCase "empty1b" $ checkRF False [] "/" @?= False + , testCase "empty2a" $ checkRF True [] "/sdfg" @?= True , testCase "empty2b" $ checkRF False [] "/sdfg" @?= False ]