diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -17,3 +17,35 @@ 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. + +-------------------------------------------------------------------------------- + +HUnit is Copyright (c) Dean Herington, 2002, all rights reserved, +and is distributed as free software under the following license. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +- Redistributions of source code must retain the above copyright +notice, this list of conditions, and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright +notice, this list of conditions, and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +- The names of the copyright holders may not be used to endorse or +promote products derived from this software without specific prior +written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR +BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN +IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Test/Tasty/HUnit.hs b/Test/Tasty/HUnit.hs --- a/Test/Tasty/HUnit.hs +++ b/Test/Tasty/HUnit.hs @@ -1,36 +1,15 @@ --- | This module allows to use HUnit tests in tasty. +-- | Unit testing support for tasty, inspired by the HUnit package {-# LANGUAGE TypeFamilies, DeriveDataTypeable #-} module Test.Tasty.HUnit ( testCase - -- | We only re-export parts of "Test.HUnit.Base" related to assertions - -- and not tests. - , module Test.HUnit.Base + , module Test.Tasty.HUnit.Orig ) where import Test.Tasty.Providers -import qualified Test.HUnit.Base -import Test.HUnit.Lang -import Test.HUnit.Base hiding -- for re-export - ( Test(..) - , Testable(..) - , (~=?) - , (~?=) - , (~:) - , (~?) - , State(..) - , Counts(..) - , Path - , Node - , testCasePaths - , testCaseCount - , ReportStart - , ReportProblem - , performTest - ) +import Test.Tasty.HUnit.Orig import Data.Typeable -import Control.Monad.Trans import Control.Exception -- | Create a 'Test' for a HUnit 'Assertion' diff --git a/Test/Tasty/HUnit/Orig.hs b/Test/Tasty/HUnit/Orig.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/HUnit/Orig.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-} +-- | This is the code copied from the original hunit package (v. 1.2.5.2). +-- with minor modifications +module Test.Tasty.HUnit.Orig where + +import qualified Control.Exception as E +import Control.Monad +import Data.Typeable (Typeable) + +-- Interfaces +-- ---------- + +-- | When an assertion is evaluated, it will output a message if and only if the +-- assertion fails. +-- +-- Test cases are composed of a sequence of one or more assertions. + +type Assertion = IO () + +-- | Unconditionally signals that a failure has occured. All +-- other assertions can be expressed with the form: +-- +-- @ +-- if conditionIsMet +-- then IO () +-- else assertFailure msg +-- @ + +assertFailure :: String -- ^ A message that is displayed with the assertion failure + -> Assertion +assertFailure msg = E.throwIO (HUnitFailure msg) + +-- Conditional Assertion Functions +-- ------------------------------- + +-- | Asserts that the specified condition holds. +assertBool :: String -- ^ The message that is displayed if the assertion fails + -> Bool -- ^ The condition + -> Assertion +assertBool msg b = unless b (assertFailure msg) + +-- | Signals an assertion failure if a non-empty message (i.e., a message +-- other than @\"\"@) is passed. +assertString :: String -- ^ The message that is displayed with the assertion failure + -> Assertion +assertString s = unless (null s) (assertFailure s) + +-- | Asserts that the specified actual value is equal to the expected value. +-- The output message will contain the prefix, the expected value, and the +-- actual value. +-- +-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted +-- and only the expected and actual values are output. +assertEqual :: (Eq a, Show a) => String -- ^ The message prefix + -> a -- ^ The expected value + -> a -- ^ The actual value + -> Assertion +assertEqual preface expected actual = + unless (actual == expected) (assertFailure msg) + where msg = (if null preface then "" else preface ++ "\n") ++ + "expected: " ++ show expected ++ "\n but got: " ++ show actual + + +-- Overloaded `assert` Function +-- ---------------------------- + +-- | Allows the extension of the assertion mechanism. +-- +-- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, +-- there is a fair amount of flexibility of what can be achieved. As a rule, +-- the resulting @Assertion@ should be the body of a 'TestCase' or part of +-- a @TestCase@; it should not be used to assert multiple, independent +-- conditions. +-- +-- If more complex arrangements of assertions are needed, 'Test's and +-- 'Testable' should be used. +class Assertable t + where assert :: t -> Assertion + +instance Assertable () + where assert = return + +instance Assertable Bool + where assert = assertBool "" + +instance (Assertable t) => Assertable (IO t) + where assert = (>>= assert) + +instance Assertable String + where assert = assertString + + +-- Overloaded `assertionPredicate` Function +-- ---------------------------------------- + +-- | The result of an assertion that hasn't been evaluated yet. +-- +-- Most test cases follow the following steps: +-- +-- 1. Do some processing or an action. +-- +-- 2. Assert certain conditions. +-- +-- However, this flow is not always suitable. @AssertionPredicate@ allows for +-- additional steps to be inserted without the initial action to be affected +-- by side effects. Additionally, clean-up can be done before the test case +-- has a chance to end. A potential work flow is: +-- +-- 1. Write data to a file. +-- +-- 2. Read data from a file, evaluate conditions. +-- +-- 3. Clean up the file. +-- +-- 4. Assert that the side effects of the read operation meet certain conditions. +-- +-- 5. Assert that the conditions evaluated in step 2 are met. +type AssertionPredicate = IO Bool + +-- | Used to signify that a data type can be converted to an assertion +-- predicate. +class AssertionPredicable t + where assertionPredicate :: t -> AssertionPredicate + +instance AssertionPredicable Bool + where assertionPredicate = return + +instance (AssertionPredicable t) => AssertionPredicable (IO t) + where assertionPredicate = (>>= assertionPredicate) + + +-- Assertion Construction Operators +-- -------------------------------- + +infix 1 @?, @=?, @?= + +-- | Asserts that the condition obtained from the specified +-- 'AssertionPredicable' holds. +(@?) :: (AssertionPredicable t) => t -- ^ A value of which the asserted condition is predicated + -> String -- ^ A message that is displayed if the assertion fails + -> Assertion +predi @? msg = assertionPredicate predi >>= assertBool msg + +-- | Asserts that the specified actual value is equal to the expected value +-- (with the expected value on the left-hand side). +(@=?) :: (Eq a, Show a) => a -- ^ The expected value + -> a -- ^ The actual value + -> Assertion +expected @=? actual = assertEqual "" expected actual + +-- | Asserts that the specified actual value is equal to the expected value +-- (with the actual value on the left-hand side). +(@?=) :: (Eq a, Show a) => a -- ^ The actual value + -> a -- ^ The expected value + -> Assertion +actual @?= expected = assertEqual "" expected actual + +-- | Exception thrown by 'assertFailure' etc. +data HUnitFailure = HUnitFailure String + deriving (Show, Typeable) +instance E.Exception HUnitFailure diff --git a/tasty-hunit.cabal b/tasty-hunit.cabal --- a/tasty-hunit.cabal +++ b/tasty-hunit.cabal @@ -2,13 +2,15 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: tasty-hunit -version: 0.8.0.1 +version: 0.9 synopsis: HUnit support for the Tasty test framework. description: HUnit support for the Tasty test framework. license: MIT license-file: LICENSE -author: Roman Cheplyaka -maintainer: roma@ro-che.info +author: Roman Cheplyaka +maintainer: Roman Cheplyaka +homepage: http://documentup.com/feuerbach/tasty +bug-reports: https://github.com/feuerbach/tasty/issues -- copyright: category: Testing build-type: Simple @@ -22,8 +24,9 @@ library exposed-modules: Test.Tasty.HUnit - -- other-modules: + other-modules: Test.Tasty.HUnit.Orig other-extensions: TypeFamilies, DeriveDataTypeable - build-depends: base ==4.*, tasty >= 0.8, HUnit, mtl + build-depends: base ==4.*, tasty >= 0.8 -- hs-source-dirs: default-language: Haskell2010 + ghc-options: -Wall