HTF 0.11.3.0 → 0.11.3.1

raw patch · 4 files changed

+14/−89 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

• ChangeLog +9/−0
• HTF.cabal +1/−2
• Test/Framework/AssertM.hs +0/−86
• Test/Framework/QuickCheckWrapper.hs +4/−1

@@ -1,3 +1,12 @@+* 0.11.3.1 (2014-04-09)+  - fix compile error under GHC 7.4 (fixes #33)++* 0.11.3.0 (2014-04-08)+  - support for generic assertions+  - fixed setDefaultArgs und withQCArgs for quickcheck tests (fixes #30)+  - added assertElem assertion (fixes #27)+  - don't output warning if fallback parsers kick (fixes #32)+ * 0.11.2.1 (2014-02-10)   - fixed compile error under ghc 7.4 

@@ -1,5 +1,5 @@ Name:             HTF-Version:          0.11.3.0+Version:          0.11.3.1 License:          LGPL License-File:     LICENSE Copyright:        (c) 2005-2012 Stefan Wehr@@ -187,7 +187,6 @@     Test.Framework.JsonOutput     Test.Framework.XmlOutput     Test.Framework.ThreadPool-    Test.Framework.AssertM   Other-Modules:     Test.Framework.TestManagerInternal     Test.Framework.Utils

@@ -1,86 +0,0 @@-{-|--This module defines the 'AssertM' monad, which allows you either to run assertions-as ordinary unit tests or to evaluate them as pure functions.---}-module Test.Framework.AssertM (--    AssertM(..), AssertStackElem(..), AssertBool(..), boolValue, eitherValue, formatStack--) where--import Data.Maybe-import qualified Data.Text as T--import Test.Framework.TestManagerInternal-import Test.Framework.Location-import Test.Framework.Colors---- | A typeclass for generic assertions.-class Monad m => AssertM m where-    genericAssertFailure__ :: Location -> ColorString -> m a-    genericSubAssert :: Location -> Maybe String -> m a -> m a--instance AssertM IO where-    genericAssertFailure__ loc s = unitTestFail (Just loc) s-    genericSubAssert loc mMsg action = unitTestSubAssert loc mMsg action---- | Stack trace element for generic assertions.-data AssertStackElem-    = AssertStackElem-      { ase_message :: Maybe String-      , ase_location :: Maybe Location-      }-      deriving (Eq, Ord, Show, Read)---- | Type for evaluating a generic assertion as a pure function.-data AssertBool a-    -- | Assertion passes successfully and yields the given value.-    = AssertOk a-    -- | Assertion fails with the given stack trace. In the stack trace, the outermost stackframe comes first.-    | AssertFailed [AssertStackElem]-      deriving (Eq, Ord, Show, Read)--instance Monad AssertBool where-    return = AssertOk-    AssertFailed stack >>= _ = AssertFailed stack-    AssertOk x >>= k = k x-    fail msg = AssertFailed [AssertStackElem (Just msg) Nothing]--instance AssertM AssertBool where-    genericAssertFailure__ loc s =-        AssertFailed [AssertStackElem (Just (T.unpack $ renderColorString s False)) (Just loc)]--    genericSubAssert loc mMsg action =-        case action of-          AssertOk x -> AssertOk x-          AssertFailed stack ->-              AssertFailed (AssertStackElem mMsg (Just loc) : stack)---- | Evaluates a generic assertion to a 'Bool' value.-boolValue :: AssertBool a -> Bool-boolValue x =-    case x of-      AssertOk _ -> True-      AssertFailed _ -> False---- | Evaluates a generic assertion to an 'Either' value. The result---   is @Right x@ if the assertion passes and yields value @x@, otherwise---   the result is @Left err@, where @err@ is an error message.-eitherValue :: AssertBool a -> Either String a-eitherValue x =-    case x of-      AssertOk z -> Right z-      AssertFailed stack -> Left (formatStack stack)---- | Formats a stack trace.-formatStack :: [AssertStackElem] -> String-formatStack stack =-    unlines $ map formatStackElem $ zip [0..] $ reverse stack-    where-      formatStackElem (pos, AssertStackElem mMsg mLoc) =-          let floc = fromMaybe "<unknown location>" $ fmap showLoc mLoc-              fmsg = fromMaybe "" $ fmap (\s -> ": " ++ s) mMsg-              pref = if pos > 0 then "  called from " else ""-          in pref ++ floc ++ fmsg

@@ -71,7 +71,10 @@ -- | Change the default 'Args' used to evaluate quick check properties. setDefaultArgs :: Args -> IO () setDefaultArgs args =-    atomicModifyIORef' qcState $ \state -> (state { qc_args = args }, ())+    do force <- atomicModifyIORef qcState $ \state ->+                  let newState = state { qc_args = args }+                  in (newState, newState)+       force `seq` return ()  -- | Retrieve the 'Args' currently used per default when evaluating quick check properties. getCurrentArgs :: IO Args