diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,14 @@ Changes ======= +Version 3.3.2.1 (31 Aug 2025) +--------------- + +* Drop support for GHC 7. +* Rudimentary treatment for `After` in `TestTree` + (cf. [#28](https://github.com/phile314/tasty-silver/issues/28)). +* Tested with GHC 8.0 - 9.12.2. + Version 3.3.2 (18 Jul 2024) ------------- diff --git a/Test/Tasty/Silver.hs b/Test/Tasty/Silver.hs --- a/Test/Tasty/Silver.hs +++ b/Test/Tasty/Silver.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + {- | This module provides a simplified interface. If you want more, see "Test.Tasty.Silver.Advanced". @@ -57,19 +57,16 @@ ) where -import Control.Monad -#if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ( (<$>) ) -#endif +import Control.Monad ( liftM, forM ) import qualified Data.ByteString as BS import qualified Data.Set as Set import qualified Data.Text as T -import Data.Text.Encoding +import Data.Text.Encoding ( decodeUtf8, encodeUtf8 ) -import System.Directory -import System.Exit -import System.FilePath -import System.Process.Text as PT +import System.Directory ( doesDirectoryExist, getDirectoryContents ) +import System.Exit ( ExitCode ) +import System.FilePath ( takeExtension ) +import System.Process.Text as PT ( readProcessWithExitCode ) import Test.Tasty.Providers (TestTree, TestName) import Test.Tasty.Silver.Advanced 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,4 @@ -{-# LANGUAGE RankNTypes, OverloadedStrings #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Test.Tasty.Silver.Advanced ( -- * Constructing golden tests @@ -16,10 +15,6 @@ 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,14 +1,8 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | Regex filtering for test trees. + module Test.Tasty.Silver.Filter ( filterWithRegex , checkRF @@ -21,40 +15,38 @@ import Prelude hiding (fail) -import Data.Maybe +import Data.Maybe ( fromJust, fromMaybe, mapMaybe ) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ( (<>) ) #endif -import Data.Tagged -import Data.Typeable +import Data.Tagged ( untag, Tagged ) import qualified Data.List as L -import Options.Applicative +import Options.Applicative ( help, long, option, str, readerError, Alternative(some), Parser ) 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 +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.Options ( IsOption(..), OptionSet, lookupOption ) +import Test.Tasty.Runners ( TestTree(After, AskOptions, SingleTest, TestGroup, PlusTestOptions, WithResource) ) -- | Path into the 'TestTree'. Separator is the slash character(@'/'@). type TestPath = String +-- Andreas, 2025-07-30, TODO: The following comment is without substance, +-- since all types have Typeable since GHC-7.10: -- we have to store the regex as String, as there is no Typeable instance -- for the Regex data type with GHC < 7.8 data RegexFilter = RFInclude String -- ^ Include tests that match. | RFExclude String -- ^ Exclude tests that match. - deriving (Typeable) -- | Tests to completely exclude, treating them like they do not exist. newtype ExcludeFilters = ExcludeFilters [RegexFilter] - deriving (Typeable) -- | Tests to completely include, treating all other tests like they do not exist. newtype IncludeFilters = IncludeFilters [RegexFilter] - deriving (Typeable) instance IsOption ExcludeFilters where defaultValue = ExcludeFilters [] @@ -135,6 +127,9 @@ -- if later on we see that the child subtree was excluded. WithResource r t -> Just $ WithResource r $ \ x -> fromMaybe emptyTest $ filter' path $ t x AskOptions t -> Just $ AskOptions $ \ o -> fromMaybe emptyTest $ filter' path $ t o +#if MIN_VERSION_tasty(1,2,0) + After dep exp t -> After dep exp <$> filter' path t +#endif x y = x ++ "/" ++ y 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,5 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | Golden test management, interactive mode. Runs the tests, and asks -- the user how to proceed in case of failure or missing golden standard. @@ -30,47 +22,45 @@ import Prelude -import Control.Concurrent.STM.TVar -import Control.Exception -import Control.Monad -import Control.Monad.Identity -import Control.Monad.Reader -import Control.Monad.STM -import Control.Monad.State +import Control.Concurrent.STM.TVar ( TVar, readTVar ) +import Control.Exception ( Exception(fromException, toException), finally ) +import Control.Monad ( when, unless ) +import Control.Monad.Identity ( Identity(Identity) ) +import Control.Monad.IO.Class ( MonadIO(liftIO) ) +import Control.Monad.Reader ( Reader, runReader, MonadReader(ask) ) +import Control.Monad.STM ( atomically, retry ) +import Control.Monad.State ( MonadState(put, get), evalState, evalStateT, modify ) -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 +import Data.Char ( toLower ) +import Data.Maybe ( fromMaybe, isJust ) +import Data.Monoid ( Any(..) ) +import Data.Proxy ( Proxy(..) ) #if !(MIN_VERSION_base(4,11,0)) -import Data.Semigroup ( Semigroup(..) ) +import Data.Semigroup ( Semigroup(..) ) #endif -import Data.Tagged -import Data.Text ( Text ) -import Data.Text.Encoding -import Data.Typeable -import qualified Data.ByteString as BS -import qualified Data.IntMap as IntMap -import qualified Data.Text as T -import qualified Data.Text.IO as TIO +import Data.Tagged ( untag, Tagged ) +import Data.Text ( Text ) +import Data.Text.Encoding ( encodeUtf8 ) +import Data.Typeable ( cast ) +import qualified Data.ByteString as BS +import qualified Data.IntMap as IntMap +import qualified Data.Text as T +import qualified Data.Text.IO as TIO -import Options.Applicative hiding (Failure, Success) +import Options.Applicative ( help, long, option, str, readerError ) import System.Console.ANSI -import System.Directory -import System.Exit -import System.FilePath +import System.Directory ( findExecutable ) +import System.Exit ( ExitCode(..) ) +import System.FilePath ( (<.>) ) import System.IO -import System.IO.Silently (silence) -import System.IO.Temp -import System.Process -import System.Process.ByteString as PS -import qualified System.Process.Text as ProcessText +import System.IO.Silently ( silence ) +import System.IO.Temp ( withSystemTempFile ) +import System.Process ( callCommand, callProcess, rawSystem, shell ) +import System.Process.ByteString as PS ( readCreateProcessWithExitCode ) +import qualified System.Process.Text as ProcessText -import Text.Printf +import Text.Printf ( printf ) import Test.Tasty hiding (defaultMain) import Test.Tasty.Options @@ -88,7 +78,6 @@ defaultMain :: TestTree -> IO () defaultMain = defaultMain1 [] - defaultMain1 :: [RegexFilter] -> TestTree -> IO () defaultMain1 filters = defaultMainWithIngredients @@ -99,7 +88,7 @@ -- | Option for interactive mode. newtype Interactive = Interactive Bool - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) instance IsOption Interactive where defaultValue = Interactive False @@ -114,7 +103,7 @@ data FancyTestException = Mismatch GoldenResultI | Disabled - deriving (Show, Typeable) + deriving (Show) instance Exception FancyTestException @@ -750,7 +739,7 @@ -- | Report only failed tests newtype HideSuccesses = HideSuccesses Bool - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) instance IsOption HideSuccesses where defaultValue = HideSuccesses False @@ -760,7 +749,6 @@ optionCLParser = flagCLParser Nothing (HideSuccesses True) newtype AnsiTricks = AnsiTricks Bool - deriving Typeable instance IsOption AnsiTricks where defaultValue = AnsiTricks True @@ -774,7 +762,7 @@ -- | When to use color on the output data UseColor = Never | Always | Auto - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) -- | Control color output instance IsOption UseColor where diff --git a/Test/Tasty/Silver/Interactive/Run.hs b/Test/Tasty/Silver/Interactive/Run.hs --- a/Test/Tasty/Silver/Interactive/Run.hs +++ b/Test/Tasty/Silver/Interactive/Run.hs @@ -1,23 +1,17 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} + module Test.Tasty.Silver.Interactive.Run ( wrapRunTest ) where -import Data.Tagged -import Data.Typeable +import Data.Tagged ( retag, Tagged ) -import Test.Tasty hiding (defaultMain) -import Test.Tasty.Options -import Test.Tasty.Providers -import Test.Tasty.Runners +import Test.Tasty.Options ( OptionDescription, OptionSet ) +import Test.Tasty.Providers ( IsTest(..), Progress, Result, TestName, TestTree ) +import Test.Tasty.Runners ( TestTree(..) ) import Test.Tasty.Silver.Filter ( TestPath ) data CustomTestExec t = IsTest t => CustomTestExec t (OptionSet -> t -> (Progress -> IO ()) -> IO Result) - deriving (Typeable) instance IsTest t => IsTest (CustomTestExec t) where run opts (CustomTestExec t r) cb = r opts t cb @@ -34,11 +28,13 @@ -> (forall t . IsTest t => TestPath -> TestName -> OptionSet -> t -> (Progress -> IO ()) -> IO Result) -> TestTree -> TestTree -wrapRunTest' tp f (SingleTest n t) = SingleTest n (CustomTestExec t (f (tp n) n)) -wrapRunTest' tp f (TestGroup n ts) = TestGroup n (fmap (wrapRunTest' (tp n) f) ts) -wrapRunTest' tp f (PlusTestOptions o t) = PlusTestOptions o (wrapRunTest' tp f t) -wrapRunTest' tp f (WithResource r t) = WithResource r (\x -> wrapRunTest' tp f (t x)) -wrapRunTest' tp f (AskOptions t) = AskOptions (\o -> wrapRunTest' tp f (t o)) +wrapRunTest' tp f = \case + SingleTest n t -> SingleTest n (CustomTestExec t (f (tp n) n)) + TestGroup n ts -> TestGroup n (fmap (wrapRunTest' (tp n) f) ts) + PlusTestOptions o t -> PlusTestOptions o (wrapRunTest' tp f t) + WithResource r t -> WithResource r (\x -> wrapRunTest' tp f (t x)) + AskOptions t -> AskOptions (\o -> wrapRunTest' tp f (t o)) + After dep expr t -> After dep expr $ wrapRunTest' tp f t () :: TestPath -> TestPath -> TestPath a b = a ++ "/" ++ b 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,25 +1,15 @@ -{-# 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 Control.Exception ( catchJust ) +import Control.Monad.Identity ( Identity(Identity) ) -import Data.ByteString as SB -#if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ( (<$>) ) -#endif -import Data.Maybe -import Data.Proxy -import Data.Typeable (Typeable) +import Data.ByteString as SB ( readFile, ByteString ) +import Data.Maybe ( fromMaybe ) +import Data.Proxy ( Proxy(..) ) import qualified Data.Text as T -import System.IO.Error +import System.IO.Error ( ioeGetErrorType, isDoesNotExistErrorType ) import Test.Tasty.Providers import Test.Tasty.Options @@ -34,14 +24,14 @@ (a -> a -> IO GDiff) -- Compare/diff. (a -> IO GShow) -- How to produce a show. (Maybe (a -> IO ())) -- Update golden value. - deriving Typeable -- | This option, when set to 'True', specifies that we should run in the -- «accept tests» mode. newtype AcceptTests = AcceptTests Bool - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) + instance IsOption AcceptTests where defaultValue = AcceptTests False parseValue = fmap AcceptTests . safeRead diff --git a/tasty-silver.cabal b/tasty-silver.cabal --- a/tasty-silver.cabal +++ b/tasty-silver.cabal @@ -1,6 +1,6 @@ -cabal-version: 1.14 +cabal-version: 1.18 name: tasty-silver -version: 3.3.2 +version: 3.3.2.1 synopsis: A fancy test runner, including support for golden tests. description: This package provides a fancy test runner and support for «golden testing». @@ -20,17 +20,18 @@ Bug-reports: https://github.com/phile314/tasty-silver/issues author: Philipp Hausmann, Andreas Abel, Roman Cheplyaka, and others maintainer: Andreas Abel, Philipp Hausmann --- copyright: category: Testing build-type: Simple -extra-source-files: +extra-doc-files: CHANGELOG.md README.md tested-with: - GHC == 9.10.1 - GHC == 9.8.2 + GHC == 9.14.1 + GHC == 9.12.2 + GHC == 9.10.2 + GHC == 9.8.4 GHC == 9.6.6 GHC == 9.4.8 GHC == 9.2.8 @@ -41,62 +42,69 @@ GHC == 8.4.4 GHC == 8.2.2 GHC == 8.0.2 - -- Drop testing with GHC 7 - -- GHC == 7.10.3 - -- GHC == 7.8.4 - -- GHC == 7.6.3 - Source-repository head type: git location: https://github.com/phile314/tasty-silver.git library - Default-language: + exposed-modules: + Test.Tasty.Silver + Test.Tasty.Silver.Advanced + Test.Tasty.Silver.Filter + Test.Tasty.Silver.Interactive + Test.Tasty.Silver.Interactive.Run + Test.Tasty.Silver.Internal + + -- Lower bounds taken from GHC 8.0 and Stackage LTS 7.0 + build-depends: + base >= 4.9 && < 5 + -- Drop support for GHC 7 + , ansi-terminal >= 0.6.2.3 + , bytestring >= 0.10.8.0 + , containers >= 0.5.7.1 + , directory >= 1.2.6.2 + , filepath >= 1.4.1.0 + , mtl >= 2.2.1 + , optparse-applicative >= 0.12.1.0 + , process >= 1.4.2.0 + , process-extras >= 0.4.1.4 + , regex-tdfa >= 1.2.2 + , silently >= 1.2.5.1 + -- 1.2.5.1 contains a bugfix (Windows NUL device) over 1.2.5 + , stm >= 2.4.4.1 + , tagged >= 0.8.5 + , tasty >= 1.4 + -- LTS 7.0 contains a much older tasty: 0.11.0.4 + , temporary >= 1.2.0.4 + , text >= 1.2.2.1 + + default-language: Haskell2010 - Default-extensions: + default-extensions: + BangPatterns + ExistentialQuantification + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving LambdaCase - exposed-modules: Test.Tasty.Silver - Test.Tasty.Silver.Advanced - Test.Tasty.Silver.Filter - Test.Tasty.Silver.Interactive - Test.Tasty.Silver.Interactive.Run - Test.Tasty.Silver.Internal - - if impl(ghc >= 8.0) - ghc-options: - -Wall - -Wno-name-shadowing - -Wcompat + MultiParamTypeClasses + PatternGuards + RankNTypes + ScopedTypeVariables + TypeSynonymInstances + other-extensions: + CPP + ImplicitParams + OverloadedStrings - build-depends: - base >= 4.6 && < 5 - -- LambdaCase supported since GHC 7.6 (base-4.6) - , ansi-terminal >= 0.6.2.1 - , async - , bytestring >= 0.10.0.0 - -- bytestring-0.10 needed by process-extras-0.3 - , containers - , directory >= 1.2.3.0 - -- withCurrentDirectory needs at least 1.2.3.0 - , deepseq - , filepath - , mtl - , optparse-applicative - , process >= 1.2 - , process-extras >= 0.3 - -- readCreateProcessWithExitCode needs at least 0.3 - , regex-tdfa >= 1.2.0 - , silently >= 1.2.5.1 - -- Andreas Abel, 2021-09-05, latest silently is today 1.2.5.1 - , stm >= 2.4.2 - , tagged - , tasty >= 1.4 - , temporary - , text >= 0.11.0.0 - , transformers >= 0.3 - if impl(ghc < 8.0) - build-depends: semigroups >= 0.18.3 + ghc-options: + -Wall + -Wno-name-shadowing + -Wcompat + -Wunused-packages + -Wincomplete-patterns + -Wincomplete-uni-patterns Test-suite test Default-language: @@ -114,15 +122,10 @@ , tasty-silver , filepath , directory - , process , silently , temporary - , transformers - if impl(ghc < 8.0) - build-depends: semigroups - if impl(ghc >= 8.0) - ghc-options: - -Wall - -Wno-name-shadowing - -Wcompat + 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 @@ -2,32 +2,28 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Concurrent.MVar -import Control.Exception as E ( catch, SomeException ) +import Control.Concurrent.MVar ( swapMVar, newMVar, readMVar ) +import Control.Exception as E ( catch, SomeException ) -- Prelude of GHC 7.4 also has @catch@, so we disambiguate with E.catch -import Control.Monad ( unless ) -import Control.Monad.IO.Class ( liftIO ) +import Control.Monad ( unless ) +import Control.Monad.IO.Class ( liftIO ) -import Data.List (sort) -#if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ( (<$) ) -import Data.Monoid ( mempty ) -#endif +import Data.List ( sort ) -import System.Directory ( createDirectory, withCurrentDirectory ) -import System.FilePath -import System.IO.Silently ( capture ) -import System.IO.Temp +import System.Directory ( createDirectory, withCurrentDirectory ) +import System.FilePath ( () ) +import System.IO.Silently ( capture ) +import System.IO.Temp ( withSystemTempDirectory ) -import Test.Tasty hiding (defaultMain) -import Test.Tasty.HUnit -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 ( withResource, testGroup ) +import Test.Tasty.HUnit ( testCase, (@?=), assertBool, assertFailure ) +import Test.Tasty.Options ( singleOption ) +import Test.Tasty.Runners ( TestTree, consoleTestReporter, tryIngredients ) +import Test.Tasty.Silver ( goldenVsFile, findByExtension ) +import Test.Tasty.Silver.Advanced ( GShow(ShowText), GDiff(Equal), goldenTest1 ) +import Test.Tasty.Silver.Filter ( checkRF ) +import Test.Tasty.Silver.Interactive ( defaultMain, runTestsInteractive ) +import Test.Tasty.Silver.Internal ( AcceptTests(AcceptTests) ) touch :: FilePath -> IO () touch f = writeFile f ""