-- | This module abstracts the differences between implementations of -- Haskell (e.g., GHC, Hugs, and NHC).moduleTest.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-- -------#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)importData.DynamicimportControl.ExceptionasE#elseimportData.List(isPrefixOf)importSystem.IO.Error(ioeGetErrorString,try)#endifimportControl.DeepSeq-- Interfaces-- ------------ | When an assertion is evaluated, it will output a message if and only if the-- assertion fails. ---- Test cases are composed of a sequence of one or more assertions.typeAssertion=IO()-- | Unconditionally signals that a failure has occured. All-- other assertions can be expressed with the form:---- @-- if conditionIsMet -- then IO () -- else assertFailure msg-- @ assertFailure::String-- ^ A message that is displayed with the assertion failure ->Assertion-- | 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 messageperformTestCase::Assertion-- ^ an assertion to be made during the test case run ->IO(Maybe(Bool,String))-- Implementations-- ---------------#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)dataHUnitFailure=HUnitFailureStringderivingShowhunitFailureTc::TyConhunitFailureTc=mkTyCon"HUnitFailure"{-# NOINLINE hunitFailureTc #-}instanceTypeableHUnitFailurewheretypeOf_=mkTyConApphunitFailureTc[]#ifdef BASE4instanceExceptionHUnitFailureassertFailuremsg=msg`deepseq`E.throwIO(HUnitFailuremsg)performTestCaseaction=doactionreturnNothing`E.catches`[E.Handler(\(HUnitFailuremsg)->return$Just(True,msg)),-- Re-throw AsyncException, otherwise execution will not terminate on-- SIGINT (ctrl-c). Currently, all AsyncExceptions are being thrown-- because it's thought that none of them will be encountered during-- normal HUnit operation. If you encounter an example where this-- is not the case, please email the maintainer.E.Handler(\e->throw(e::E.AsyncException)),E.Handler(\e->return$Just(False,show(e::E.SomeException)))]#elseassertFailuremsg=msg`deepseq`E.throwDyn(HUnitFailuremsg)performTestCaseaction=dor<-E.tryactioncaserofRight()->returnNothingLefte@(E.DynExceptiondyn)->casefromDynamicdynofJust(HUnitFailuremsg)->return$Just(True,msg)Nothing->return$Just(False,showe)Lefte->return$Just(False,showe)#endif#elsehunitPrefix="HUnit:"nhc98Prefix="I/O error (user-defined), call to function `userError':\n "assertFailuremsg=msg`deepseq`ioError(userError(hunitPrefix++msg))performTestCaseaction=dor<-tryactioncaserofRight()->returnNothingLefte->return(Just(decodee))wheredecodee=lets0=ioeGetErrorStringe(_,s1)=dropPrefixnhc98Prefixs0indropPrefixhunitPrefixs1dropPrefixprefstr=ifpref`isPrefixOf`strthen(True,drop(lengthpref)str)else(False,str)#endif