diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,14 @@ +### 0.8.2.0 + +- Add `Semigroup` instances +- Avoid orphan-instance clashing by using `base-orphans`'s orphan `Functor` instances `base` < 4.7 +- Make `-Wall` clean + +#### 0.8.1.1 + +- Fix a build warning that happens to be a fatal error with GHC 7.4 when using `ansi-wl-pprint` < 0.6.6 + +### 0.8.1.0 + +- Add `Applicative` instances +- Add support for `time-1.5.0` 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/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,4 +0,0 @@ -#! /usr/bin/env runhaskell - -> import Distribution.Simple -> main = defaultMain diff --git a/Test/Framework/Core.hs b/Test/Framework/Core.hs --- a/Test/Framework/Core.hs +++ b/Test/Framework/Core.hs @@ -31,7 +31,7 @@ type TestTypeName = String -- | Main test data type: builds up a list of tests to be run. Users should use the --- utility functions in e.g. the test-framework-hunit and test-framework-quickcheck +-- utility functions in e.g. the test-framework-hunit and test-framework-quickcheck2 -- packages to create instances of 'Test', and then build them up into testsuites -- by using 'testGroup' and lists. -- diff --git a/Test/Framework/Improving.hs b/Test/Framework/Improving.hs --- a/Test/Framework/Improving.hs +++ b/Test/Framework/Improving.hs @@ -6,7 +6,7 @@ import Control.Concurrent import Control.Monad -import Control.Applicative +import Control.Applicative as App import System.Timeout @@ -37,11 +37,11 @@ fmap = liftM instance Applicative (ImprovingIO i f) where - pure = return + pure x = IIO (const $ return x) (<*>) = ap instance Monad (ImprovingIO i f) where - return x = IIO (const $ return x) + return = App.pure ma >>= f = IIO $ \chan -> do a <- unIIO ma chan unIIO (f a) chan diff --git a/Test/Framework/Options.hs b/Test/Framework/Options.hs --- a/Test/Framework/Options.hs +++ b/Test/Framework/Options.hs @@ -4,6 +4,7 @@ import Test.Framework.Utilities import Data.Monoid +import Data.Semigroup as Sem hiding (Last(..)) type TestOptions = TestOptions' Maybe @@ -23,6 +24,16 @@ -- ^ The number of microseconds to run tests for before considering them a failure } +instance Sem.Semigroup (TestOptions' Maybe) where + to1 <> to2 = TestOptions { + topt_seed = getLast (mappendBy (Last . topt_seed) to1 to2), + topt_maximum_generated_tests = getLast (mappendBy (Last . topt_maximum_generated_tests) to1 to2), + topt_maximum_unsuitable_generated_tests = getLast (mappendBy (Last . topt_maximum_unsuitable_generated_tests) to1 to2), + topt_maximum_test_size = getLast (mappendBy (Last . topt_maximum_test_size) to1 to2), + topt_maximum_test_depth = getLast (mappendBy (Last . topt_maximum_test_depth) to1 to2), + topt_timeout = getLast (mappendBy (Last . topt_timeout) to1 to2) + } + instance Monoid (TestOptions' Maybe) where mempty = TestOptions { topt_seed = Nothing, @@ -33,11 +44,4 @@ topt_timeout = Nothing } - mappend to1 to2 = TestOptions { - topt_seed = getLast (mappendBy (Last . topt_seed) to1 to2), - topt_maximum_generated_tests = getLast (mappendBy (Last . topt_maximum_generated_tests) to1 to2), - topt_maximum_unsuitable_generated_tests = getLast (mappendBy (Last . topt_maximum_unsuitable_generated_tests) to1 to2), - topt_maximum_test_size = getLast (mappendBy (Last . topt_maximum_test_size) to1 to2), - topt_maximum_test_depth = getLast (mappendBy (Last . topt_maximum_test_depth) to1 to2), - topt_timeout = getLast (mappendBy (Last . topt_timeout) to1 to2) - } + mappend = (Sem.<>) diff --git a/Test/Framework/Runners/Console.hs b/Test/Framework/Runners/Console.hs --- a/Test/Framework/Runners/Console.hs +++ b/Test/Framework/Runners/Console.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - module Test.Framework.Runners.Console ( defaultMain, defaultMainWithArgs, defaultMainWithOpts, SuppliedRunnerOptions, optionsDescription, @@ -23,16 +21,11 @@ import System.Exit import System.IO +#if !MIN_VERSION_base(4,8,0) import Data.Monoid - -#if !MIN_VERSION_base(4,7,0) -instance Functor OptDescr where - fmap f (Option a b arg_descr c) = Option a b (fmap f arg_descr) c - -instance Functor ArgDescr where - fmap f (NoArg a) = NoArg (f a) - fmap f (ReqArg g s) = ReqArg (f . g) s - fmap f (OptArg g s) = OptArg (f . g) s +#endif +#if !(MIN_VERSION_base(4,7,0)) +import Data.Orphans () #endif -- | @Nothing@ signifies that usage information should be displayed. diff --git a/Test/Framework/Runners/Console/Run.hs b/Test/Framework/Runners/Console/Run.hs --- a/Test/Framework/Runners/Console/Run.hs +++ b/Test/Framework/Runners/Console/Run.hs @@ -18,7 +18,9 @@ import Text.PrettyPrint.ANSI.Leijen +#if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty) +#endif import Control.Arrow (second, (&&&)) import Control.Monad (unless) diff --git a/Test/Framework/Runners/Core.hs b/Test/Framework/Runners/Core.hs --- a/Test/Framework/Runners/Core.hs +++ b/Test/Framework/Runners/Core.hs @@ -16,7 +16,9 @@ import Control.Exception (mask, finally, onException) import Control.Monad import Data.Maybe +#if !MIN_VERSION_base(4,8,0) import Data.Monoid +#endif import Data.Typeable diff --git a/Test/Framework/Runners/Options.hs b/Test/Framework/Runners/Options.hs --- a/Test/Framework/Runners/Options.hs +++ b/Test/Framework/Runners/Options.hs @@ -8,6 +8,7 @@ import Test.Framework.Runners.TestPattern import Data.Monoid +import Data.Semigroup as Sem hiding (Last(..)) data ColorMode = ColorAuto | ColorNever | ColorAlways @@ -24,6 +25,18 @@ ropt_list_only :: f Bool } +instance Semigroup (RunnerOptions' Maybe) where + ro1 <> ro2 = RunnerOptions { + ropt_threads = getLast (mappendBy (Last . ropt_threads) ro1 ro2), + ropt_test_options = mappendBy ropt_test_options ro1 ro2, + ropt_test_patterns = mappendBy ropt_test_patterns ro1 ro2, + ropt_xml_output = mappendBy ropt_xml_output ro1 ro2, + ropt_xml_nested = getLast (mappendBy (Last . ropt_xml_nested) ro1 ro2), + ropt_color_mode = getLast (mappendBy (Last . ropt_color_mode) ro1 ro2), + ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2), + ropt_list_only = getLast (mappendBy (Last . ropt_list_only) ro1 ro2) + } + instance Monoid (RunnerOptions' Maybe) where mempty = RunnerOptions { ropt_threads = Nothing, @@ -36,13 +49,4 @@ ropt_list_only = Nothing } - mappend ro1 ro2 = RunnerOptions { - ropt_threads = getLast (mappendBy (Last . ropt_threads) ro1 ro2), - ropt_test_options = mappendBy ropt_test_options ro1 ro2, - ropt_test_patterns = mappendBy ropt_test_patterns ro1 ro2, - ropt_xml_output = mappendBy ropt_xml_output ro1 ro2, - ropt_xml_nested = getLast (mappendBy (Last . ropt_xml_nested) ro1 ro2), - ropt_color_mode = getLast (mappendBy (Last . ropt_color_mode) ro1 ro2), - ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2), - ropt_list_only = getLast (mappendBy (Last . ropt_list_only) ro1 ro2) - } + mappend = (Sem.<>) diff --git a/Test/Framework/Runners/Statistics.hs b/Test/Framework/Runners/Statistics.hs --- a/Test/Framework/Runners/Statistics.hs +++ b/Test/Framework/Runners/Statistics.hs @@ -10,7 +10,10 @@ import Data.Map (Map) import qualified Data.Map as Map +#if !MIN_VERSION_base(4,8,0) import Data.Monoid +#endif +import Data.Semigroup as Sem -- | Records a count of the various kinds of test that have been run @@ -30,9 +33,12 @@ testCountTotal :: TestCount -> Int testCountTotal = sum . Map.elems . unTestCount +instance Semigroup TestCount where + TestCount tcm1 <> TestCount tcm2 = TestCount $ Map.unionWith (+) tcm1 tcm2 + instance Monoid TestCount where mempty = TestCount $ Map.empty - mappend (TestCount tcm1) (TestCount tcm2) = TestCount $ Map.unionWith (+) tcm1 tcm2 + mappend = (Sem.<>) minusTestCount :: TestCount -> TestCount -> TestCount minusTestCount (TestCount tcm1) (TestCount tcm2) = TestCount $ Map.unionWith (-) tcm1 tcm2 @@ -48,9 +54,12 @@ ts_failed_tests :: TestCount } +instance Semigroup TestStatistics where + TestStatistics tot1 run1 pas1 fai1 <> TestStatistics tot2 run2 pas2 fai2 = TestStatistics (tot1 Sem.<> tot2) (run1 Sem.<> run2) (pas1 Sem.<> pas2) (fai1 Sem.<> fai2) + instance Monoid TestStatistics where mempty = TestStatistics mempty mempty mempty mempty - mappend (TestStatistics tot1 run1 pas1 fai1) (TestStatistics tot2 run2 pas2 fai2) = TestStatistics (tot1 `mappend` tot2) (run1 `mappend` run2) (pas1 `mappend` pas2) (fai1 `mappend` fai2) + mappend = (Sem.<>) ts_pending_tests :: TestStatistics -> TestCount ts_pending_tests ts = ts_total_tests ts `minusTestCount` ts_run_tests ts diff --git a/Test/Framework/Utilities.hs b/Test/Framework/Utilities.hs --- a/Test/Framework/Utilities.hs +++ b/Test/Framework/Utilities.hs @@ -4,7 +4,9 @@ import Data.Function (on) import Data.Maybe +#if !MIN_VERSION_base(4,8,0) import Data.Monoid +#endif import Data.List (intercalate) diff --git a/test-framework.cabal b/test-framework.cabal --- a/test-framework.cabal +++ b/test-framework.cabal @@ -1,6 +1,6 @@ Name: test-framework -Version: 0.8.1.1 -Cabal-Version: >= 1.6 +Version: 0.8.2.0 +Cabal-Version: >= 1.10 Category: Testing Synopsis: Framework for running and organising tests, with HUnit and QuickCheck support Description: Allows tests such as QuickCheck properties and HUnit test cases to be assembled into test groups, run in @@ -10,14 +10,12 @@ License-File: LICENSE Author: Max Bolingbroke Maintainer: Libraries List -Homepage: https://batterseapower.github.io/test-framework/ -Bug-Reports: https://github.com/haskell/test-framework/issues/ +Homepage: http://haskell.github.io/test-framework/ +Bug-Reports: https://github.com/haskell/test-framework/issues Build-Type: Simple - -Flag Tests - Description: Build the tests - Default: False +Tested-With: 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.2.2, GHC==7.0.4 +Extra-Source-Files: ChangeLog.md Library Exposed-Modules: Test.Framework @@ -46,14 +44,25 @@ Test.Framework.Runners.XML Test.Framework.Utilities - Build-Depends: ansi-terminal >= 0.4.0, ansi-wl-pprint >= 0.5.1, - base >= 4.3 && < 5, random >= 1.0, containers >= 0.1, - regex-posix >= 0.72, - old-locale >= 1.0, - time >= 1.1.2 && < 1.6, - xml >= 1.3.5, hostname >= 1.0 + Build-Depends: base >= 4.3 && < 5 + , ansi-terminal >= 0.4.0 && < 0.9 + , ansi-wl-pprint >= 0.5.1 && < 0.7 + , random >= 1.0 && < 1.2 + , containers >= 0.1 && < 0.6 + , regex-posix >= 0.72 && < 0.96 + , old-locale >= 1.0 && < 1.1 + , time >= 1.1.2 && < 1.9 + , xml >= 1.3.5 && < 1.4 + , hostname >= 1.0 && < 1.1 - Extensions: CPP + if !impl(ghc >= 7.8) + Build-Depends: base-orphans >= 0.1 && < 0.5 + + if !impl(ghc >= 8.0) + Build-Depends: semigroups >= 0.18 && < 0.19 + + Default-Language: Haskell2010 + Default-Extensions: CPP PatternGuards ExistentialQuantification RecursiveDo @@ -63,42 +72,60 @@ FunctionalDependencies MultiParamTypeClasses + -- workaround https://github.com/haskell/cabal/issues/4443 + if impl(ghc >= 7.2) + Default-Extensions: NondecreasingIndentation Ghc-Options: -Wall if impl(ghc) Cpp-Options: -DCOMPILER_GHC -Executable test-framework-tests + if impl(ghc >= 8.0) + Ghc-Options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + +Test-Suite test-framework-tests Main-Is: Test/Framework/Tests.hs + Type: exitcode-stdio-1.0 - if !flag(tests) - Buildable: False - else - Build-Depends: HUnit >= 1.2, QuickCheck >= 2.3 && < 2.5, - base >= 4.3 && < 5, random >= 1.0, containers >= 0.1, - ansi-terminal >= 0.4.0, ansi-wl-pprint >= 0.5.1, - regex-posix >= 0.72, - old-locale >= 1.0, time >= 1.1.2, - xml >= 1.3.5, hostname >= 1.0, - libxml >= 0.1.1, bytestring >= 0.9 + -- Buildable: False + Build-Depends: HUnit >= 1.2 + , QuickCheck >= 2.3 && < 2.10 + , base >= 4.3 + , random >= 1.0 + , containers >= 0.1 + , ansi-terminal >= 0.4.0 + , ansi-wl-pprint >= 0.5.1 + , regex-posix >= 0.72 + , old-locale >= 1.0 + , time >= 1.1.2 + , xml >= 1.3.5 + , hostname >= 1.0 + , libxml >= 0.1.1 + , bytestring >= 0.9 + , semigroups >= 0.18 - Extensions: CPP - PatternGuards - ExistentialQuantification - RecursiveDo - FlexibleInstances - TypeSynonymInstances - TypeOperators - FunctionalDependencies - MultiParamTypeClasses + Default-Language: Haskell2010 + Default-Extensions: CPP + PatternGuards + ExistentialQuantification + RecursiveDo + FlexibleInstances + TypeSynonymInstances + TypeOperators + FunctionalDependencies + MultiParamTypeClasses - Cpp-Options: -DTEST + if impl(ghc >= 7.2) + Default-Extensions: NondecreasingIndentation - Ghc-Options: -Wall -threaded + Cpp-Options: -DTEST - if impl(ghc) - Cpp-Options: -DCOMPILER_GHC + Ghc-Options: -Wall -threaded + if impl(ghc) + Cpp-Options: -DCOMPILER_GHC + Source-Repository head Type: git - Location: https://github.com/haskell/test-framework + Location: https://github.com/haskell/test-framework.git + subdir: core