packages feed

HUnit 1.4.0.0 → 1.6.2.0

raw patch · 8 files changed

Files

CHANGELOG.md view
@@ -1,5 +1,21 @@ ## Changes +#### 1.6.2.0++- Add support for GHC 7.0.* and 7.2.*++#### 1.6.1.0++- Add `Test.HUnit.Text.runTestTTAndExit`++#### 1.6.0.0++- Generalize return type of `assertFailure` to `IO a`++#### 1.5.0.0++- Preserve actual/expected for `assertEqual` failures+ #### 1.4.0.0  - Depend on `call-stack`
HUnit.cabal view
@@ -1,10 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.15.0.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.3. -- -- see: https://github.com/sol/hpack  name:                   HUnit-version:                1.4.0.0-cabal-version:          >= 1.10+version:                1.6.2.0 license:                BSD3 license-file:           LICENSE author:                 Dean Herington@@ -17,7 +18,6 @@ description:            HUnit is a unit testing framework for Haskell, inspired by the                         JUnit tool for Java, see: <http://www.junit.org>. build-type:             Simple- extra-source-files:   CHANGELOG.md   README.md@@ -30,9 +30,9 @@   hs-source-dirs:     src   build-depends:-    base == 4.*,-    deepseq,-    call-stack+    base ==4.*,+    call-stack >=0.3.0,+    deepseq   exposed-modules:     Test.HUnit.Base     Test.HUnit.Lang@@ -51,15 +51,16 @@     tests     examples   build-depends:-    base == 4.*,+    HUnit,+    base ==4.*,+    call-stack >=0.3.0,     deepseq,-    call-stack,-    filepath,-    HUnit+    filepath   other-modules:     HUnitTestBase     HUnitTestExtended     TerminalTest     Example+    Paths_HUnit   default-language: Haskell2010   ghc-options: -Wall
README.md view
@@ -10,7 +10,7 @@ easy to create, change, and execute. The [JUnit](www.junit.org) tool pioneered support for test-first development in [Java](http://java.sun.com). HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional-programming language. (To learn more about Haskell, see www.haskell.org](http://www.haskell.org).+programming language. (To learn more about Haskell, see [www.haskell.org](http://www.haskell.org)).  With HUnit, as with JUnit, you can easily create tests, name them, group them into suites, and execute them, with the framework checking the results automatically. Test@@ -143,7 +143,7 @@  With `assertString` the two are combined. With `assertEqual` you provide a  "preface", an expected value, and an actual value; the failure message shows the two  unequal values and is prefixed by the preface. Additional ways to create assertions are- described later under [Avanced Features](#advanced-features)+ described later under [Advanced Features](#advanced-features)  Since assertions are `IO` computations, they may be combined--along with other      `IO` computations--using `(>>=)`, `(>>)`, and the `do`
src/Test/HUnit/Base.hs view
@@ -1,6 +1,13 @@-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#define HasCallStack_ HasCallStack =>+#else+#define HasCallStack_+#endif+ -- | Basic definitions for the HUnit library. -- --   This module contains what you need to create assertions and test cases and@@ -52,36 +59,19 @@ -- -------------------------------  -- | Asserts that the specified condition holds.-assertBool :: HasCallStack-           => String    -- ^ The message that is displayed if the assertion fails+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 :: HasCallStack-             => String    -- ^ The message that is displayed with the assertion failure+assertString :: HasCallStack_+                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 :: (HasCallStack, 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 -- ---------------------------- @@ -96,7 +86,7 @@ -- If more complex arrangements of assertions are needed, 'Test's and -- 'Testable' should be used. class Assertable t- where assert :: HasCallStack => t -> Assertion+ where assert :: HasCallStack_ t -> Assertion  instance Assertable ()  where assert = return@@ -112,7 +102,7 @@  -- | A specialized form of 'Assertable' to handle lists. class ListAssertable t- where listAssert :: HasCallStack => [t] -> Assertion+ where listAssert :: HasCallStack_ [t] -> Assertion  instance ListAssertable Char  where listAssert = assertString@@ -164,7 +154,7 @@  -- | Asserts that the condition obtained from the specified --   'AssertionPredicable' holds.-(@?) :: (HasCallStack, AssertionPredicable t)+(@?) :: HasCallStack_ AssertionPredicable t                                 => t          -- ^ A value of which the asserted condition is predicated                                 -> String     -- ^ A message that is displayed if the assertion fails                                 -> Assertion@@ -172,7 +162,7 @@  -- | Asserts that the specified actual value is equal to the expected value --   (with the expected value on the left-hand side).-(@=?) :: (HasCallStack, Eq a, Show a)+(@=?) :: HasCallStack_ (Eq a, Show a)                         => a -- ^ The expected value                         -> a -- ^ The actual value                         -> Assertion@@ -180,7 +170,7 @@  -- | Asserts that the specified actual value is equal to the expected value --   (with the actual value on the left-hand side).-(@?=) :: (HasCallStack, Eq a, Show a)+(@?=) :: HasCallStack_ (Eq a, Show a)                         => a -- ^ The actual value                         -> a -- ^ The expected value                         -> Assertion@@ -211,7 +201,7 @@  -- | Provides a way to convert data into a @Test@ or set of @Test@. class Testable t- where test :: HasCallStack => t -> Test+ where test :: HasCallStack_ t -> Test  instance Testable Test  where test = id@@ -231,7 +221,7 @@  -- | Creates a test case resulting from asserting the condition obtained --   from the specified 'AssertionPredicable'.-(~?) :: (HasCallStack, AssertionPredicable t)+(~?) :: HasCallStack_ AssertionPredicable t                                 => t       -- ^ A value of which the asserted condition is predicated                                 -> String  -- ^ A message that is displayed on test failure                                 -> Test@@ -240,7 +230,7 @@ -- | Shorthand for a test case that asserts equality (with the expected --   value on the left-hand side, and the actual value on the right-hand --   side).-(~=?) :: (HasCallStack, Eq a, Show a)+(~=?) :: HasCallStack_ (Eq a, Show a)                         => a     -- ^ The expected value                         -> a     -- ^ The actual value                         -> Test@@ -249,7 +239,7 @@ -- | Shorthand for a test case that asserts equality (with the actual --   value on the left-hand side, and the expected value on the right-hand --   side).-(~?=) :: (HasCallStack, Eq a, Show a)+(~?=) :: HasCallStack_ (Eq a, Show a)                         => a     -- ^ The actual value                         -> a     -- ^ The expected value                         -> Test@@ -260,7 +250,7 @@ -- -- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching -- a 'TestLabel' to one or more tests.-(~:) :: (HasCallStack, Testable t) => String -> t -> Test+(~:) :: HasCallStack_ Testable t => String -> t -> Test label ~: t = TestLabel label (test t)
src/Test/HUnit/Lang.hs view
@@ -1,10 +1,18 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#define HasCallStack_ HasCallStack =>+#else+#define HasCallStack_+#endif+ module Test.HUnit.Lang (   Assertion,   assertFailure,+  assertEqual,    Result (..),   performTestCase,@@ -12,11 +20,15 @@ -- | -- /Note:/ This is not part of the public API!  It is exposed so that you can -- tinker with the internals of HUnit, but do not expect it to be stable!-  HUnitFailure (..)+  HUnitFailure (..),+  FailureReason (..),+  formatFailureReason ) where  import           Control.DeepSeq import           Control.Exception as E+import           Control.Monad+import           Data.List import           Data.Typeable import           Data.CallStack @@ -26,30 +38,51 @@ -- Test cases are composed of a sequence of one or more assertions. type Assertion = IO () -data HUnitFailure = HUnitFailure (Maybe SrcLoc) String+data HUnitFailure = HUnitFailure (Maybe SrcLoc) FailureReason     deriving (Eq, Show, Typeable)  instance Exception HUnitFailure --- | Unconditionally signals that a failure has occured.  All--- other assertions can be expressed with the form:------ @---    if conditionIsMet---        then IO ()---        else assertFailure msg--- @+data FailureReason = Reason String | ExpectedButGot (Maybe String) String String+    deriving (Eq, Show, Typeable)++location :: HasCallStack_ Maybe SrcLoc+location = case reverse callStack of+  (_, loc) : _ -> Just loc+  [] -> Nothing++-- | Unconditionally signals that a failure has occurred. assertFailure ::-     HasCallStack =>+     HasCallStack_      String -- ^ A message that is displayed with the assertion failure-  -> Assertion-assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location msg)+  -> IO a+assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location $ Reason msg)++-- | 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 :: HasCallStack_ (Eq a, Show a)+                              => String -- ^ The message prefix+                              -> a      -- ^ The expected value+                              -> a      -- ^ The actual value+                              -> Assertion+assertEqual preface expected actual =+  unless (actual == expected) $ do+    (prefaceMsg `deepseq` expectedMsg `deepseq` actualMsg `deepseq` E.throwIO (HUnitFailure location $ ExpectedButGot prefaceMsg expectedMsg actualMsg))   where-    location :: Maybe SrcLoc-    location = case reverse callStack of-      (_, loc) : _ -> Just loc-      [] -> Nothing+    prefaceMsg+      | null preface = Nothing+      | otherwise = Just preface+    expectedMsg = show expected+    actualMsg = show actual +formatFailureReason :: FailureReason -> String+formatFailureReason (Reason reason) = reason+formatFailureReason (ExpectedButGot preface expected actual) = intercalate "\n" . maybe id (:) preface $ ["expected: " ++ expected, " but got: " ++ actual]+ data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String   deriving (Eq, Show) @@ -59,7 +92,7 @@ performTestCase action =   (action >> return Success)      `E.catches`-      [E.Handler (\(HUnitFailure loc msg) -> return $ Failure loc msg),+      [E.Handler (\(HUnitFailure loc reason) -> return $ Failure loc (formatFailureReason reason)),         -- Re-throw AsyncException, otherwise execution will not terminate on        -- SIGINT (ctrl-c).  Currently, all AsyncExceptions are being thrown
src/Test/HUnit/Text.hs view
@@ -7,7 +7,8 @@   putTextToHandle, putTextToShowS,   runTestText,   showPath, showCounts,-  runTestTT+  runTestTT,+  runTestTTAndExit ) where @@ -16,6 +17,7 @@ import Data.CallStack import Control.Monad (when) import System.IO (Handle, stderr, hPutStr, hPutStrLn)+import System.Exit (exitSuccess, exitFailure)   -- | As the general text-based test controller ('runTestText') executes a@@ -130,3 +132,21 @@ runTestTT :: Test -> IO Counts runTestTT t = do (counts', 0) <- runTestText (putTextToHandle stderr True) t                  return counts'++-- | Convenience wrapper for 'runTestTT'.+--   Simply runs 'runTestTT' and then exits back to the OS,+--   using 'exitSuccess' if there were no errors or failures,+--   or 'exitFailure' if there were. For example:+--+--   > tests :: Test+--   > tests = ...+--   >+--   > main :: IO ()+--   > main = runTestTTAndExit tests++runTestTTAndExit :: Test -> IO ()+runTestTTAndExit tests = do+  c <- runTestTT tests+  if (errors c == 0) && (failures c == 0)+    then exitSuccess+    else exitFailure
tests/HUnitTestBase.lhs view
@@ -81,7 +81,7 @@ > ok :: Test > ok = test (assert ()) > bad :: String -> Test-> bad m = test (assertFailure m)+> bad m = test (assertFailure m :: Assertion)   > assertTests :: Test@@ -108,7 +108,7 @@  >   "assertFailure" ~: >     let msg = "simple assertFailure"->     in expectFailure msg (test (assertFailure msg)),+>     in expectFailure msg (test (assertFailure msg :: Assertion)),  >   "assertString null" ~: expectSuccess (TestCase (assertString "")),
tests/HUnitTestExtended.hs view
@@ -1,34 +1,18 @@-{-# LANGUAGE CPP #-}-module HUnitTestExtended (-    extendedTests-    ) where+module HUnitTestExtended (extendedTests) where  import Test.HUnit import HUnitTestBase -#if MIN_VERSION_base(4,9,0)-errorCall :: a-errorCall = error "error"-#endif- extendedTests :: Test extendedTests = test [--    -- Hugs doesn't currently catch arithmetic exceptions.-     "div by 0" ~:-        expectUnspecifiedError (TestCase ((3 `div` 0 :: Integer) `seq` return ())),+        expectError "divide by zero" (TestCase ((3 `div` 0 :: Integer) `seq` return ())),      "list ref out of bounds" ~:         expectUnspecifiedError (TestCase ([1 .. 4 :: Integer] !! 10 `seq` return ())), -#if MIN_VERSION_base(4,9,0)-    "error" ~:-        expectError "error\nCallStack (from HasCallStack):\n  error, called at tests/HUnitTestExtended.hs:11:13 in main:HUnitTestExtended" (TestCase errorCall),-#else      "error" ~:-        expectError "error" (TestCase (error "error")),-#endif+        expectUnspecifiedError (TestCase (error "error")),      "tail []" ~:         expectUnspecifiedError (TestCase (tail [] `seq` return ()))