Test/HUnit/Lang.lhs  --  HUnit language support.

> module Test.HUnit.Lang
> (
>   Assertion,
>   assertFailure,
>   performTestCase
> )
> where


When adapting this module for other Haskell language systems, change
the imports and the implementations but not the interfaces.



Imports
-------

> import Data.List (isPrefixOf)
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
> import Data.Dynamic
> import Control.Exception as E
#else
> import System.IO.Error (ioeGetErrorString, try)
#endif



Interfaces
----------

An assertion is an `IO` computation with trivial result.

> type Assertion = IO ()

`assertFailure` signals an assertion failure with a given message.

> assertFailure :: String -> Assertion

`performTestCase` performs a single test case.  The meaning of the
result is as follows:
  Nothing               test case success
  Just (True,  msg)     test case failure with the given message
  Just (False, msg)     test case error with the given message

> performTestCase :: Assertion -> IO (Maybe (Bool, String))


Implementations
---------------

#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
> data HUnitFailure = HUnitFailure String
>     deriving Show
>
> hunitFailureTc :: TyCon
> hunitFailureTc = mkTyCon "HUnitFailure"
> {-# NOINLINE hunitFailureTc #-}
> 
> instance Typeable HUnitFailure where
>     typeOf _ = mkTyConApp hunitFailureTc []
#ifdef BASE4
> instance Exception HUnitFailure

> assertFailure msg = E.throw (HUnitFailure msg)

> performTestCase action = 
>     do action
>        return Nothing
>      `E.catches`
>        [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)),
>         E.Handler (\e -> return $ Just (False, show (e :: E.SomeException)))]
#else
> assertFailure msg = E.throwDyn (HUnitFailure msg)

> performTestCase action =
>     do r <- E.try action
>        case r of
>          Right () -> return Nothing
>          Left e@(E.DynException dyn) ->
>              case fromDynamic dyn of
>                Just (HUnitFailure msg) -> return $ Just (True, msg)
>                Nothing                 -> return $ Just (False, show e)
>          Left e -> return $ Just (False, show e)
#endif
#else
> hunitPrefix = "HUnit:"

> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n  "

> assertFailure msg = ioError (userError (hunitPrefix ++ msg))

> performTestCase action = do r <- try action
>                             case r of Right () -> return Nothing
>                                       Left  e  -> return (Just (decode e))
>  where
>   decode e = let s0 = ioeGetErrorString e
>                  (_, s1) = dropPrefix nhc98Prefix s0
>              in            dropPrefix hunitPrefix s1
>   dropPrefix pref str = if pref `isPrefixOf` str
>                           then (True, drop (length pref) str)
>                           else (False, str)
#endif