tasty-silver 3.2.2 → 3.2.3
raw patch · 9 files changed
+254/−110 lines, 9 filesdep +silentlydep ~basenew-uploader
Dependencies added: silently
Dependency ranges changed: base
Files
- CHANGELOG.md +7/−1
- README.md +36/−0
- Test/Tasty/Silver.hs +11/−8
- Test/Tasty/Silver/Advanced.hs +5/−0
- Test/Tasty/Silver/Filter.hs +17/−9
- Test/Tasty/Silver/Interactive.hs +46/−30
- Test/Tasty/Silver/Internal.hs +29/−14
- tasty-silver.cabal +37/−9
- tests/test.hs +66/−39
CHANGELOG.md view
@@ -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)
+ README.md view
@@ -0,0 +1,36 @@+[](http://hackage.haskell.org/package/tasty-silver)+[](https://stackage.org/nightly/package/tasty-silver)+[](https://www.stackage.org/package/tasty-silver)+[](https://github.com/phile314/tasty-silver/actions/workflows/haskell-ci.yml)+[](https://github.com/phile314/tasty-silver/actions/workflows/macOS.yml)+[](https://github.com/phile314/tasty-silver/actions/workflows/windows.yml)+[](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.
Test/Tasty/Silver.hs view
@@ -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
Test/Tasty/Silver/Advanced.hs view
@@ -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
Test/Tasty/Silver/Filter.hs view
@@ -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 "" []-
Test/Tasty/Silver/Interactive.hs view
@@ -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
Test/Tasty/Silver/Internal.hs view
@@ -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.
tasty-silver.cabal view
@@ -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
tests/test.hs view
@@ -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 ]