tasty-hunit 0.9.2 → 0.10

raw patch · 5 files changed

+156/−55 lines, 5 filesdep +call-stackPVP ok

version bump matches the API change (PVP)

Dependencies added: call-stack

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Test/Tasty/HUnit.hs +59/−5
• Test/Tasty/HUnit/Orig.hs +84/−45
• Test/Tasty/HUnit/Steps.hs +3/−2
• tasty-hunit.cabal +3/−3

@@ -1,6 +1,13 @@ Changes ======= +Version 0.10+------------++* Make `assertFailure`'s return type polymorphic+* When a test fails, print the source location of the failing assertion+* Deprecate `Assertable`, `AssertionPredicate`, `AssertionPredicable`, `(@?)`+ Version 0.9.2 ------------- 

@@ -1,10 +1,63 @@--- | Unit testing support for tasty, inspired by the HUnit package+-- | Unit testing support for tasty, inspired by the HUnit package.+--+-- Here's an example (a single tasty test case consisting of three+-- assertions):+--+-- >import Test.Tasty+-- >import Test.Tasty.HUnit+-- >+-- >main = defaultMain $+-- >  testCase "Example test case" $ do+-- >    -- assertion no. 1 (passes)+-- >    2 + 2 @?= 4+-- >    -- assertion no. 2 (fails)+-- >    assertBool "the list is not empty" $ null [1]+-- >    -- assertion no. 3 (would have failed, but won't be executed because+-- >    -- the previous assertion has already failed)+-- >    "foo" @?= "bar" {-# LANGUAGE TypeFamilies, DeriveDataTypeable #-} module Test.Tasty.HUnit-  ( testCase+  (+    -- * Constructing test cases+    testCase   , testCaseInfo   , testCaseSteps-  , module Test.Tasty.HUnit.Orig+    -- * Constructing assertions+  , assertFailure+  , assertBool+  , assertEqual+  , (@=?)+  , (@?=)+    -- * Data types+  , Assertion+  , HUnitFailure(..)+    -- * Accurate location for domain-specific assertion functions+    -- | It is common to define domain-specific assertion functions based+    -- on the standard ones, e.g.+    --+    -- > assertNonEmpty = assertBool "List is empty" . not . null+    --+    -- The problem is that if a test fails, tasty-hunit will point to the+    -- definition site of @assertNonEmpty@ as the source of failure, not+    -- its use site.+    --+    -- To correct this, add a 'HasCallStack' constraint (re-exported from+    -- this module) to your function:+    --+    -- > assertNonEmpty :: HasCallStack => [a] -> Assertion+    -- > assertNonEmpty = assertBool "List is empty" . not . null+    --+    , HasCallStack+    -- * Deprecated functions and types+    -- | These definitions come from HUnit, but I don't see why one would+    -- need them. If you have a valid use case for them, please contact me+    -- or file an issue for tasty. Otherwise, they will eventually be+    -- removed.+  , assertString+  , Assertable(..)+  , AssertionPredicate+  , AssertionPredicable(..)+  , (@?)   ) where  import Test.Tasty.Providers@@ -13,9 +66,10 @@ import Test.Tasty.HUnit.Steps  import Data.Typeable+import Data.CallStack (HasCallStack) import Control.Exception --- | Create a 'Test' for a HUnit 'Assertion'+-- | Turn an 'Assertion' into a tasty test case testCase :: TestName -> Assertion -> TestTree testCase name = singleTest name . TestCase . (fmap (const "")) @@ -49,6 +103,6 @@     return $       case hunitResult of         Right info -> testPassed info-        Left (HUnitFailure message) -> testFailed message+        Left (HUnitFailure mbloc message) -> testFailed $ prependLocation mbloc message    testOptions = return []

@@ -1,4 +1,8 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-}++-- required for HasCallStack by different versions of GHC+{-# LANGUAGE ConstraintKinds, FlexibleContexts #-}+ -- | This is the code copied from the original hunit package (v. 1.2.5.2). -- with minor modifications module Test.Tasty.HUnit.Orig where@@ -6,13 +10,17 @@ import qualified Control.Exception as E import Control.Monad import Data.Typeable (Typeable)+import Data.CallStack  -- Interfaces -- ---------- --- | When an assertion is evaluated, it will output a message if and only if the--- assertion fails.  +-- | An assertion is simply an 'IO' action. Assertion failure is indicated+-- by throwing an exception, typically 'HUnitFailure'. --+-- Instead of throwing the exception directly, you should use+-- functions like 'assertFailure' and 'assertBool'.+-- -- Test cases are composed of a sequence of one or more assertions.  type Assertion = IO ()@@ -21,55 +29,104 @@ -- other assertions can be expressed with the form: -- -- @---    if conditionIsMet ---        then IO () +--    if conditionIsMet+--        then return () --        else assertFailure msg--- @ +-- @ -assertFailure :: String -- ^ A message that is displayed with the assertion failure -              -> Assertion-assertFailure msg = E.throwIO (HUnitFailure msg)+assertFailure+  :: HasCallStack+  => String -- ^ A message that is displayed with the assertion failure+  -> IO a+assertFailure msg = E.throwIO (HUnitFailure location msg)+  where+    location :: Maybe SrcLoc+    location = case reverse callStack of+      (_, loc) : _ -> Just loc+      [] -> Nothing  -- 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+  :: HasCallStack+  => 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 +-- 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+  :: (Eq a, Show a, HasCallStack)+  => 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 +-- | 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, HasCallStack)+  => 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, HasCallStack)+  => a -- ^ The actual value+  -> a -- ^ The expected value+  -> Assertion+actual @?= expected = assertEqual "" expected actual++-- | Exception thrown by 'assertFailure' etc.+data HUnitFailure = HUnitFailure (Maybe SrcLoc) String+    deriving (Eq, Show, Typeable)+instance E.Exception HUnitFailure++prependLocation :: Maybe SrcLoc -> String -> String+prependLocation mbloc s =+  case mbloc of+    Nothing -> s+    Just loc -> srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ ":\n" ++ s++----------------------------------------------------------------------+--                          DEPRECATED CODE+----------------------------------------------------------------------++{-# DEPRECATED assertString "Why not use assertBool instead?" #-}+{-# DEPRECATED Assertable, AssertionPredicate, AssertionPredicable, (@?)+   "This class or function seems dubious. If you have a good use case for it, please create an issue for tasty. Otherwise, it may be removed in a future version." #-}++-- | Signals an assertion failure if a non-empty message (i.e., a message+-- other than @\"\"@) is passed.+assertString+  :: HasCallStack+  => String    -- ^ The message that is displayed with the assertion failure+  -> Assertion+assertString s = unless (null s) (assertFailure s)+ -- Overloaded `assert` Function -- ----------------------------  -- | Allows the extension of the assertion mechanism. ----- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, +-- 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 +-- a @TestCase@; it should not be used to assert multiple, independent -- conditions. -- -- If more complex arrangements of assertions are needed, 'Test's and@@ -111,13 +168,13 @@ -- 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 +-- | Used to signify that a data type can be converted to an assertion -- predicate. class AssertionPredicable t  where assertionPredicate :: t -> AssertionPredicate@@ -141,21 +198,3 @@                                 -> 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

@@ -5,6 +5,7 @@ import Control.Exception import Data.IORef import Data.Typeable (Typeable)+import Prelude  -- Silence AMP import warnings import Test.Tasty.HUnit.Orig import Test.Tasty.Providers @@ -28,14 +29,14 @@          Right {} -> testPassed (unlines msgs) -        Left (HUnitFailure errMsg) -> testFailed $+        Left (HUnitFailure mbloc errMsg) -> testFailed $           if null msgs             then               errMsg             else               -- Indent the error msg w.r.t. step messages               unlines $-                msgs ++ map ("  " ++) (lines errMsg)+                msgs ++ map ("  " ++) (lines . prependLocation mbloc $ errMsg)    testOptions = return [] 

@@ -2,14 +2,14 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tasty-hunit-version:             0.9.2+version:             0.10 synopsis:            HUnit support for the Tasty test framework. description:         HUnit support for the Tasty test framework. license:             MIT license-file:        LICENSE author:              Roman Cheplyaka <roma@ro-che.info> maintainer:          Roman Cheplyaka <roma@ro-che.info>-homepage:            http://documentup.com/feuerbach/tasty+homepage:            https://github.com/feuerbach/tasty bug-reports:         https://github.com/feuerbach/tasty/issues -- copyright:            category:            Testing@@ -27,7 +27,7 @@   other-modules:       Test.Tasty.HUnit.Orig                        Test.Tasty.HUnit.Steps   other-extensions:    TypeFamilies, DeriveDataTypeable-  build-depends:       base ==4.*, tasty >= 0.8+  build-depends:       base ==4.*, tasty >= 0.8, call-stack   -- hs-source-dirs:         default-language:    Haskell2010   ghc-options: -Wall