packages feed

tasty-hunit 0.2 → 0.10.2

raw patch · 6 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,98 @@+Changes+=======++Version 0.10.2+--------------++* Teach `testCaseSteps` to log progress+  ([#387](https://github.com/UnkindPartition/tasty/pull/387)).++Version 0.10.1+---------------++* Provide an explicit implementation of `displayException`+  in `instance Exception HUnitFailure`+  ([#330](https://github.com/UnkindPartition/tasty/issues/330)).++Version 0.10.0.3+----------------++The only point of this release is to introduce compatibility with GHCs back to 7.0+(see https://github.com/UnkindPartition/tasty/pull/287).++Note, however, that these changes are not merged to the master branch, and the+future releases will only support the GHC/base versions from the last 5 years,+as per our usual policy. To test with even older GHCs, you'll have to use this+particular version of tasty-hunit (or have the constraint solver pick it for you+when testing with older GHCs).++The source of this release is in the `support-old-ghcs` branch of the tasty+repository.++Version 0.10.0.2+----------------++Catch all exceptions and time each step in testCaseSteps++Version 0.10.0.1+----------------++Un-deprecate `(@?)` and `AssertionPredicable` and improve their docs++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+-------------++Add `testCaseInfo` for tests that return some information upon success++Version 0.9.1+-------------++Add `testCaseSteps` for multi-step tests++Version 0.9.0.1+---------------++Split the changelog out of the main tasty changelog++Version 0.9+-----------++tasty-hunit now does not depend on the original HUnit package. The functions+that were previously re-exported from HUnit have been simply copied to+tasty-hunit.++This is motivated by:++* efficiency (one less package to compile/install)+* reliability (if something happens with HUnit, we won't be affected)++The two packages are still compatible, except for the name clashes and+distinct exception types being thrown on assertion failures.++Version 0.8.0.1+---------------++Fix unbuildable haddock++Version 0.8+-----------++* Exceptions are now handled by tasty rather than by HUnit+* Update to tasty-0.8++Version 0.4.1+-------------++Do not re-export HUnit's `Testable` class++Version 0.2+-----------++Re-export useful bits of `Test.HUnit` from `Test.Tasty.HUnit`
LICENSE view
@@ -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.
Test/Tasty/HUnit.hs view
@@ -1,57 +1,108 @@--- | This module allows to use HUnit tests in tasty. +-- | 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-  -- | We only re-export parts of "Test.HUnit.Base" related to assertions-  -- and not tests.-  , module Test.HUnit.Base+  (+    -- * Constructing test cases+    testCase+  , testCaseInfo+  , testCaseSteps+    -- * Constructing assertions+  , assertFailure+  , assertBool+  , assertEqual+  , (@=?)+  , (@?=)+  , (@?)+  , AssertionPredicable(..)+    -- * 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   ) where  import Test.Tasty.Providers -import qualified Test.HUnit.Base-import Test.HUnit.Lang-import Test.HUnit.Base hiding -- for re-export-  ( Test(..)-  , (~=?)-  , (~?=)-  , (~:)-  , (~?)-  , State(..)-  , Counts(..)-  , Path-  , Node-  , testCasePaths-  , testCaseCount-  , ReportStart-  , ReportProblem-  , performTest-  )+import Test.Tasty.HUnit.Orig+import Test.Tasty.HUnit.Steps  import Data.Typeable-import Control.Monad.Trans+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+testCase name = singleTest name . TestCase . (fmap (const "")) -newtype TestCase = TestCase Assertion+-- | Like 'testCase', except in case the test succeeds, the returned string+-- will be shown as the description. If the empty string is returned, it+-- will be ignored.+testCaseInfo :: TestName -> IO String -> TestTree+testCaseInfo name = singleTest name . TestCase++-- IO String is a computation that throws an exception upon failure or+-- returns an informational string otherwise. This allows us to unify the+-- implementation of 'testCase' and 'testCaseInfo'.+--+-- In case of testCase, we simply make the result string empty, which makes+-- tasty ignore it.+newtype TestCase = TestCase (IO String)     deriving Typeable  instance IsTest TestCase where   run _ (TestCase assertion) _ = do-    hunitResult <- performTestCase assertion+  -- The standard HUnit's performTestCase catches (almost) all exceptions.+  --+  -- This is bad for a few reasons:+  -- - it interferes with timeout handling+  -- - it makes exception reporting inconsistent across providers+  -- - it doesn't provide enough information for ingredients such as+  -- tasty-rerun+  --+  -- So we do it ourselves.+    hunitResult <- try assertion     return $       case hunitResult of-        Nothing ->-          Result-            { resultSuccessful = True-            , resultDescription = ""-            }-        Just (_, message)  ->-          Result-            { resultSuccessful = False-            , resultDescription = message-            }+        Right info -> testPassed info+        Left (HUnitFailure mbloc message) -> testFailed $ prependLocation mbloc message    testOptions = return []
+ Test/Tasty/HUnit/Orig.hs view
@@ -0,0 +1,218 @@+{-# 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++import qualified Control.Exception as E+import Control.Monad+import Data.Typeable (Typeable)+import Data.CallStack++-- Interfaces+-- ----------++-- | 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 ()++-- | Unconditionally signals that a failure has occured.  All+-- other assertions can be expressed with the form:+--+-- @+--    if conditionIsMet+--        then return ()+--        else assertFailure 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+  :: HasCallStack+  => String    -- ^ The message that is displayed if the assertion fails+  -> Bool      -- ^ The condition+  -> Assertion+assertBool msg b = unless b (assertFailure 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+  :: (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++infix  1 @?, @=?, @?=++-- | 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++-- | An infix and flipped version of 'assertBool'. E.g. instead of+--+-- >assertBool "Non-empty list" (null [1])+--+-- you can write+--+-- >null [1] @? "Non-empty list"+--+-- '@?' is also overloaded to accept @'IO' 'Bool'@ predicates, so instead+-- of+--+-- > do+-- >   e <- doesFileExist "test"+-- >   e @? "File does not exist"+--+-- you can write+--+-- > doesFileExist "test" @? "File does not exist"+(@?) :: (AssertionPredicable t, HasCallStack)+  => 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++-- | An ad-hoc class used to overload the '@?' operator.+--+-- The only intended instances of this class are @'Bool'@ and @'IO' 'Bool'@.+--+-- You shouldn't need to interact with this class directly.+class AssertionPredicable t+ where assertionPredicate :: t -> IO Bool++instance AssertionPredicable Bool+ where assertionPredicate = return++instance (AssertionPredicable t) => AssertionPredicable (IO t)+ where assertionPredicate = (>>= assertionPredicate)+++-- | Exception thrown by 'assertFailure' etc.+data HUnitFailure = HUnitFailure (Maybe SrcLoc) String+    deriving (Eq, Show, Typeable)+instance E.Exception HUnitFailure where+  displayException (HUnitFailure mbloc s) = prependLocation mbloc s++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+   "This class or type 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,+-- 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@ 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+
+ Test/Tasty/HUnit/Steps.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DeriveDataTypeable, BangPatterns #-}+module Test.Tasty.HUnit.Steps (testCaseSteps) where++import Control.Applicative+import Control.Exception+import Data.IORef+import Data.List (foldl')+import Data.Typeable (Typeable)+import Prelude  -- Silence AMP import warnings+import Test.Tasty.HUnit.Orig+import Test.Tasty.Providers+import Test.Tasty.Runners (getTime)+import Text.Printf (printf)++newtype TestCaseSteps = TestCaseSteps ((String -> IO ()) -> Assertion)+  deriving Typeable++instance IsTest TestCaseSteps where+  run _ (TestCaseSteps assertionFn) yieldProgress = do+    ref <- newIORef []++    let+      stepFn :: String -> IO ()+      stepFn msg = do+        tme <- getTime+        -- The number of steps is not fixed, so we can't +        -- provide the progress percentage.+        -- We also don't provide the timings here, only+        -- at the end.+        yieldProgress (Progress msg 0)+        atomicModifyIORef ref (\l -> ((tme,msg):l, ()))++    hunitResult <- (Right <$> assertionFn stepFn) `catch`+        \(SomeException ex) -> return $ Left (displayException ex)++    endTime <- getTime++    maxMsgLength <- foldl' max 0 . map (length . snd) <$> readIORef ref++    let msgFormat = "%-" ++ show (min maxMsgLength 62) ++ "s (%.02fs)"++    msgs <- snd . foldl'+      (\(lastTime, acc) (curTime, msg) ->+           let !duration = lastTime - curTime+               !msg' = if duration >= 0.01 then printf msgFormat msg duration else msg+            in (curTime, msg':acc))+      (endTime, [])+        <$> readIORef ref++    return $+      case hunitResult of++        Right {} -> testPassed (unlines msgs)++        Left errMsg -> testFailed $+          if null msgs+            then+              errMsg+            else+              -- Indent the error msg w.r.t. step messages+              unlines $+                msgs ++ map ("  " ++) (lines errMsg)++  testOptions = return []++-- | Create a multi-step unit test.+--+-- Example:+--+-- >main = defaultMain $ testCaseSteps "Multi-step test" $ \step -> do+-- >  step "Preparing..."+-- >  -- do something+-- >+-- >  step "Running part 1"+-- >  -- do something+-- >+-- >  step "Running part 2"+-- >  -- do something+-- >  assertFailure "BAM!"+-- >+-- >  step "Running part 3"+-- >  -- do something+--+-- The @step@ calls are mere annotations. They let you see which steps were+-- performed successfully, and which step failed.+--+-- You can think of @step@+-- as 'putStrLn', except 'putStrLn' would mess up the output with the+-- console reporter and get lost with the others.+--+-- For the example above, the output will be+--+-- >Multi-step test: FAIL+-- >  Preparing...+-- >  Running part 1+-- >  Running part 2+-- >    BAM!+-- >+-- >1 out of 1 tests failed (0.00s)+--+-- Note that:+--+-- * Tasty still treats this as a single test, even though it consists of+-- multiple steps.+--+-- * The execution stops after the first failure. When we are looking at+-- a failed test, we know that all /displayed/ steps but the last one were+-- successful, and the last one failed. The steps /after/ the failed one+-- are /not displayed/, since they didn't run.+testCaseSteps :: TestName -> ((String -> IO ()) -> Assertion) -> TestTree+testCaseSteps name = singleTest name . TestCaseSteps
tasty-hunit.cabal view
@@ -1,24 +1,37 @@--- Initial tasty-hunit.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/- name:                tasty-hunit-version:             0.2+version:             0.10.2 synopsis:            HUnit support for the Tasty test framework. description:         HUnit support for the Tasty test framework.+                     .+                     Note that this package does not depend on HUnit but+                     implements the relevant subset of its API. The name is a+                     legacy of the early versions of tasty-hunit and of+                     test-framework-hunit, which did depend on HUnit. license:             MIT license-file:        LICENSE-author:              Roman Cheplyaka-maintainer:          roma@ro-che.info+author:              Roman Cheplyaka <roma@ro-che.info>+maintainer:          Roman Cheplyaka <roma@ro-che.info>+homepage:            https://github.com/UnkindPartition/tasty+bug-reports:         https://github.com/UnkindPartition/tasty/issues -- copyright:            category:            Testing build-type:          Simple--- extra-source-files:  +extra-source-files:  CHANGELOG.md cabal-version:       >=1.10 +Source-repository head+  type:     git+  location: https://github.com/UnkindPartition/tasty.git+  subdir:   hunit+ library   exposed-modules:     Test.Tasty.HUnit-  -- other-modules:       +  other-modules:       Test.Tasty.HUnit.Orig+                       Test.Tasty.HUnit.Steps   other-extensions:    TypeFamilies, DeriveDataTypeable-  build-depends:       base ==4.*, tasty, HUnit, mtl+  build-depends:       base >= 4.8 && < 5,+                       tasty >= 1.2.2 && < 1.6,+                       call-stack < 0.5   -- hs-source-dirs:         default-language:    Haskell2010+  ghc-options: -Wall