module Test.Framework.TestManagerInternal (
UnitTestResult(..),
quickCheckTestFail, quickCheckTestError, quickCheckTestPending,
quickCheckTestPass, deserializeQuickCheckMsg,
unitTestFail, unitTestPending, deserializeHUnitMsg, unitTestSubAssert,
blackBoxTestFail,
) where
import Test.Framework.TestTypes
import Test.Framework.Utils
import Test.Framework.Location
import qualified Test.HUnit.Lang as HU
import Control.Monad.Trans
import Control.Monad.Trans.Control
import qualified Control.Exception.Lifted as Exc
assertFailureHTF :: String -> Assertion
assertFailureHTF s = length s `seq` HU.assertFailure s
quickCheckTestError :: Maybe String -> Assertion
quickCheckTestError m = assertFailureHTF (show (Error, m))
quickCheckTestFail :: Maybe String -> Assertion
quickCheckTestFail m = assertFailureHTF (show (Fail, m))
quickCheckTestPending :: String -> Assertion
quickCheckTestPending m = assertFailureHTF (show (Pending, Just m))
quickCheckTestPass :: String -> Assertion
quickCheckTestPass m = assertFailureHTF (show (Pass, Just m))
deserializeQuickCheckMsg :: String -> (TestResult, String)
deserializeQuickCheckMsg msg =
case readM msg of
Nothing ->
(Error, msg)
Just (r, ms) ->
case ms of
Nothing -> (r, "")
Just s -> (r, s)
data UnitTestResult
= UnitTestResult
{ utr_location :: Maybe Location
, utr_callingLocations :: [(Maybe String, Location)]
, utr_message :: String
, utr_pending :: Bool
} deriving (Eq, Show, Read)
unitTestFail :: Maybe Location -> String -> IO a
unitTestFail loc s =
do assertFailureHTF (show (UnitTestResult loc [] s False))
error "unitTestFail: UNREACHABLE"
unitTestSubAssert :: MonadBaseControl IO m => Location -> Maybe String -> m a -> m a
unitTestSubAssert loc mMsg action =
action `Exc.catch` (\(HU.HUnitFailure s) -> let res = deserializeHUnitMsg s
newRes = res { utr_callingLocations = (mMsg, loc) : utr_callingLocations res }
in Exc.throwIO (HU.HUnitFailure $ show newRes))
unitTestPending :: String -> IO a
unitTestPending s =
do assertFailureHTF (show (UnitTestResult Nothing [] s True))
error "unitTestFail: UNREACHABLE"
deserializeHUnitMsg :: String -> UnitTestResult
deserializeHUnitMsg msg =
case readM msg of
Just r -> r
_ -> UnitTestResult Nothing [] msg False
blackBoxTestFail :: String -> Assertion
blackBoxTestFail = assertFailureHTF