tasty-hunit 0.10.0.1 → 0.10.0.2

raw patch · 3 files changed

+38/−8 lines, 3 filesdep ~tasty

Dependency ranges changed: tasty

Files

• CHANGELOG.md +5/−0
• Test/Tasty/HUnit/Steps.hs +26/−6
• tasty-hunit.cabal +7/−2

@@ -1,6 +1,11 @@ Changes ======= +Version 0.10.0.2+----------------++Catch all exceptions and time each step in testCaseSteps+ Version 0.10.0.1 ---------------- 

@@ -1,13 +1,16 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# 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@@ -18,25 +21,42 @@      let       stepFn :: String -> IO ()-      stepFn msg = atomicModifyIORef ref (\l -> (msg:l, ()))+      stepFn msg = do+        tme <- getTime+        atomicModifyIORef ref (\l -> ((tme,msg):l, ())) -    hunitResult <- try (assertionFn stepFn)+    hunitResult <- (Right <$> assertionFn stepFn) `catches`+      [ Handler (\(HUnitFailure mbloc errMsg) -> return $ Left (prependLocation mbloc errMsg))+      , Handler (\(SomeException ex)          -> return $ Left (show ex))+      ] -    msgs <- reverse <$> readIORef ref+    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 (HUnitFailure mbloc errMsg) -> testFailed $+        Left errMsg -> testFailed $           if null msgs             then               errMsg             else               -- Indent the error msg w.r.t. step messages               unlines $-                msgs ++ map ("  " ++) (lines . prependLocation mbloc $ errMsg)+                msgs ++ map ("  " ++) (lines errMsg)    testOptions = return [] 

@@ -2,9 +2,14 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tasty-hunit-version:             0.10.0.1+version:             0.10.0.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 <roma@ro-che.info>@@ -27,7 +32,7 @@   other-modules:       Test.Tasty.HUnit.Orig                        Test.Tasty.HUnit.Steps   other-extensions:    TypeFamilies, DeriveDataTypeable-  build-depends:       base ==4.*, tasty >= 0.8, call-stack+  build-depends:       base ==4.*, tasty >= 1.2.2, call-stack   -- hs-source-dirs:         default-language:    Haskell2010   ghc-options: -Wall